• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Opgelost Inladen van een .csv bestand dmv macro vereenvoudigen - vervolg

Dit topic is als opgelost gemarkeerd

anton44

Verenigingslid
Lid geworden
20 mei 2005
Berichten
1.780
Als verdere optimalisering van threads/inladen-van-een-csv-bestand-dmv-macro-vereenvoudigen.975056

In de downloadmap kunnen verschillende versies koment te staan, t.w.
power-chart-data (3).csv
power-chart-data (2).csv
power-chart-data (1).csv
power-chart-data.csv
- het aantal is variabel -
De macro in 975056 selecteert alleen "power-chart-data.csv" terwijl de hoogste versie (laatste in tijd) de meest actuele info bevat die ik eigenlijk wil inladen.
Tot op dit moment heb ik dat opgelost met een batch file (toegevoegd)
Is er een mogelijkheid dit te bereiken met VBA als toevoeging op die van 975056 ?
Code:
@echo off
rem CSVweg.bat
set path="c:\Windows\System32\"
d:
cd\downloads\
if not exist "power-chart-data (3).csv" goto next0 (
del "power-chart-data (2).csv"
del "power-chart-data (1).csv"
del "power-chart-data.csv"
rename "power-chart-data (3).csv" "power-chart-data.csv" >nul
) else (
goto next0
:next0
if not exist "power-chart-data (2).csv" goto next1 (
del "power-chart-data (1).csv"
del "power-chart-data.csv"
rename "power-chart-data (2).csv" "power-chart-data.csv" >nul
) else (
goto next1
:next1
if not exist "power-chart-data (1).csv" goto next2 (
del "power-chart-data.csv"
rename "power-chart-data (1).csv" "power-chart-data.csv" >nul
) else (
goto next2
:next2
if not exist "power-chart-data.csv" (
echo:
echo           Geen bestand gevonden
echo:
pause
) else (
goto next4
:next4
exit
)
 
Bijvoorbeeld zo:
Code:
Function ZoekImportCSV() As String
    For i = 10 To 1 Step -1
        filenaam="d:\downloads\power-chart-data (" & i & ").csv"
        If Dir(filenaam) <> "" Then
            ZoekImportCSV = filenaam
            Exit Function
        End If
    Next
    MsgBox "Geen importbestand gevonden"
End Function
 
@AHulpje,
Weer actief ! Bedankt.
Geen idee hoe ik deze moet runnen.
Hoe kan ik deze codes verwerken in die van topic 975056 = modImport
Hierbij denk ik ook aan de variabelen in filenaam voor doenloadmap en bestandsnaam.
Dim csvPath As String
Dim rng As Range
Dim maxWatt As Double
Dim datum As Date
Dim tijd As String
 
Het principe werkt maar het bestand "power-chart-data.csv" wordt niet verwijderd ondanks de regel
kill csvPath actief is.
 
Dat klopt, de file die verwijderd wordt is het geïmporteerde bestand, en dat is dus niet altijd power-chart-data.csv. Maar met bijgaande code worden alle importbestanden (power-chart-data*.csv) na een importactie verwijderd.
 

Bijlagen

Dat is weer snel en perfect gefixt. Bedankt alweer.
 
Wat te vroeg gejuigd.
Indien er maar een enkel bestand in de downloadmap staat komt een foutmelding.Screen-20250622_134950-01.jpg
 
Zelf gevonden oplossing:
'Als geen file met volgnummer wordt gevonden dan kijken of er een file zonder volgnummer is.
' If ZoekImportCSV = "" Then ZoekImportCSV = Dir(csvPath)
If ZoekImportCSV = "" Then ZoekImportCSV = csvPath
 
Bijna, gaat nog fout als er helemaal geen importfile te vinden is, dus beter zo:
Code:
    If ZoekImportCSV = "" Then
        If Dir(csvPath) <> "" Then ZoekImportCSV = csvPath
    End If
 
Sinds vandaag gaat er toch iets fout.
Als er geen downloadbestand is wordt dat gemeld maar met een downloadbestand wordt er geen data weggeschreven.
Kan het iets te maken hebben met het datumformaat? = "1-07-2025 07:00","571.63385",""
Een digit minder voor de dag ?
 
Ik neem aan dat je de foutmelding "typen komen niet met elkaar overeen" hebt gekregen, klopt dat?
De datum moet inderdaad op een andere manier uit kolom 1 worden gehaald:
Code:
    datum = Split(Cells(rng.Row, 1), " ")(0)
    tijd = Split(Cells(rng.Row, 1), " ")(1)
Maar met Workbooks.Open csvPath wordt het CSV bestand geïnterpreteerd als US, de datum 1-7-2025 wordt dan gezien als 7 jan 2025. Tot nu toe ging dat goed omdat Excel dag en maand automatisch omdraait als de maand groter is dan 12, dus 17-6-2025 werd gezien als dd-mm-yyyy.
De import moet worden gewijzigd m.b.v. QueryTables, het (tijdelijk) wijzigen van je System Locale naar Nederlands zou ook kunnen, maar is niet aan te raden, dat heeft namelijk invloed op al je programma's.
Dus even geduld a.u.b.
 
Ik neem aan dat je de foutmelding "typen komen niet met elkaar overeen" hebt gekregen, klopt dat?
Op een van mijn laptops kwam inderdaad deze melding (Fout 13 tijdens uitvoering) maar op de andere geen foutmelding maar ook geen datavulling in de doelcellen.
Misschien heeft het verschil te maken met de datumnotatie van Windows.
De 1e heeft 1-07-2025 de 2e 01-07-2025
 
Laatst bewerkt:
Vervang de inhoud van de importmodule door bijgaande code.
En kijk op de "andere" laptop eens of de datavulling per abuis in rij 14 heeft plaatsgevonden.
 

Bijlagen

anders een all-in-1 oplossing, bovenin eventueel het path of de file aanpassen

Code:
Private Const MijnPath = "c:\users\eigenaar\downloads"     'subdirectory met die files
Private Const MijnFile = "power-chart-data*.csv"     'filter op die files

Sub FindMaxInCSV()
     Dim MijnFiles, i, sn, sp, sp1, aOut, x(1 To 2)
     x(2) = -1                               'voor te starten zet max op -1
     s = MijnPath & IIf(Right(MijnPath, 1) <> "\", "\", "") & MijnFile
     MijnFiles = Split(CreateObject("WScript.Shell").Exec("cmd /c dir """ & s & """  /o:-d /b /a-d ").StdOut.readall, vbCrLf)     'al je files gesorteerd aflopend op datum

     If UBound(MijnFiles) < 1 Then
          MsgBox "probleem"
     Else
          s = MijnPath & IIf(Right(MijnPath, 1) <> "\", "\", "") & MijnFiles(0)
          sn = Split(CreateObject("scripting.filesystemobject").opentextfile(s).readall, vbLf)     'open jongste file en splitten op vblf
          ReDim aOut(1 To UBound(sn), 1 To 2)     'aanmaak matrix
          For i = 1 To UBound(sn)
               If Len(sn(i)) Then
                    sp = Split(Replace(sn(i), Chr(34), ""), ",", 2)
                    sp1 = Split(Replace(Replace(sp(0), "-", " "), Chr(34), ""))
                    If UBound(sp1) = 3 Then aOut(i, 1) = CDbl(DateSerial(sp1(2), sp1(1), sp1(0)) + TimeValue(sp1(3)))
                    aOut(i, 2) = Val(Replace("0" & sp(1), ",", "."))
                    If aOut(i, 2) > x(2) Then x(2) = aOut(i, 2): x(1) = aOut(i, 1)
               End If
          Next
          MsgBox Join(x, vbLf)

          rij = Application.IfError(Application.Match(CLng(x(1)), Columns(7), 0), 0)
          If rij = 0 Then
               MsgBox "Datum " & datum & " niet gevonden!", vbCritical, "Waarschuwing"
          Else
               Cells(rij, 15) = Round(x(2), 2)
               Cells(rij, 16) = x(1) - Int(x(1))
          End If
     End If
End Sub
 

Bijlagen

Op die zonder foutmelding werkt het script weer perfect.
Op de andere machine is de cursur wel naar regel 10 cel Piekwatt gegaan maar de data niet overschreven.
 
Terug
Bovenaan Onderaan