Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

gelöst CSV-Dateien mit VBA einlesen nach bestimmtem Namen

Mitglied: sunshine89

sunshine89 (Level 1) - Jetzt verbinden

13.10.2014 um 11:52 Uhr, 1008 Aufrufe, 7 Kommentare

Hallo,

ich habe in einem Lösungsvorschlag zur Frage "Alle CSV-Dateien in einem Ordner mit einem VBA Makro einlesen" (27.08.2013) schon den fast perfekten Code zu meinem Problem gefunden. Leider bin ich totaler VBA-Anfänger und muss bei mir aber nicht alle csv-Dateien einlesen, sondern nur diejenigen, welche zwischen zwei Daten liegen die ich vorher festlegen möchte.
Die Datumsangaben finden sich in den Dateinamen wieder zb. "Datensatz_20130820.csv" also 20.08.2013.
Wie könnte ich nun eine Schleife bauen, dass nur die in einem Zeitraum liegenden Daten eingelesen werden?
Ich würde mich riesig über Hilfe freuen

01.
 
02.
Sub ImportiereCSVDateien()  
03.
 
04.
    Const CSVPFAD = "E:\csv-dateien"  
05.
    Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet, ts As Worksheet  
06.
    Set fso = CreateObject("Scripting.Filesystemobject")  
07.
    Set wbTarget = ActiveWorkbook  
08.
    Application.DisplayAlerts = False  
09.
    'Lösche alle Worksheets bevor wir alle neu anlegen  
10.
    While wbTarget.Worksheets.Count > 1  
11.
            wbTarget.Worksheets(1).Delete  
12.
    Wend  
13.
   wbTarget.Worksheets(1).Name = "Zusammenfassung"  
14.
    wbTarget.Worksheets(1).Range("A:ZZ").Clear  
15.
    For Each f In fso.GetFolder(CSVPFAD).Files  
16.
        If LCase(Right(f.Name, 3)) = "csv" Then  
17.
            Workbooks.OpenText Filename:=f.Path  
18.
            Set wbSource = ActiveWorkbook  
19.
            On Error Resume Next  
20.
            Set ws = wbTarget.Worksheets(f.Name)  
21.
            If Err <> 0 Then  
22.
                Set ws = wbTarget.Worksheets.Add  
23.
                ws.Name = f.Name  
24.
                ws.Range("A:ZZ").Clear  
25.
            End If  
26.
            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True  
27.
            wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")  
28.
            wbSource.Close False  
29.
        End If  
30.
    Next  
31.
    Set ts = wbTarget.Worksheets("Zusammenfassung")  
32.
    Dim curCell As Range  
33.
    Set curCell = ts.Range("A1")  
34.
    For i = 1 To wbTarget.Worksheets.Count - 1  
35.
        maxRow = wbTarget.Worksheets(i).Range("A1").End(xlDown).Row  
36.
        maxCol = wbTarget.Worksheets(i).Range("A1").End(xlToRight).Column  
37.
        wbTarget.Worksheets(i).Range(wbTarget.Worksheets(i).Cells(1, 1), wbTarget.Worksheets(i).Cells(maxRow, maxCol)).Copy Destination:=curCell  
38.
        Set curCell = curCell.End(xlDown).Offset(2, 0)  
39.
    Next  
40.
Application.DisplayAlerts = True  
41.
    Set fso = Nothing  
42.
End Sub 
43.
 

Gruß

sunshine89
Mitglied: 114757
LÖSUNG 13.10.2014, aktualisiert um 14:04 Uhr
01.
Sub ImportiereCSVDateien()  
02.
    On Error Resume Next  
03.
    Const CSVPFAD = "E:\csv-dateien" 
04.
    strStartDate = "01.10.2014" 
05.
    strEndDate = "15.10.2014" 
06.
    'Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet, ts As Worksheet  
07.
    Set fso = CreateObject("Scripting.Filesystemobject")  
08.
    Set wbTarget = ActiveWorkbook  
09.
    Application.DisplayAlerts = False  
10.
    'Lösche alle Worksheets bevor wir alle neu anlegen  
11.
    While wbTarget.Worksheets.Count > 1  
12.
            wbTarget.Worksheets(1).Delete  
13.
    Wend  
14.
   wbTarget.Worksheets(1).Name = "Zusammenfassung"  
15.
    wbTarget.Worksheets(1).Range("A:ZZ").Clear  
16.
    For Each f In fso.GetFolder(CSVPFAD).Files  
17.
        If fso.GetExtensionName(f.Name) = "csv" Then 
18.
        	strBasename = fso.GetBaseName(f.Name) 
19.
    		fDate = CDate(Mid(strBasename,Len(strBasename)-1,2) & "." & Mid(strBasename,Len(strBasename)-3,2) & "." & Mid(strBasename,Len(strBasename)-7,4)) 
20.
    	 	If fDate >= CDate(strStartDate) And fDate <= CDate(strEndDate) Then 
21.
	            Workbooks.OpenText Filename:=f.Path  
22.
	            Set wbSource = ActiveWorkbook 
23.
	            Set ws = wbTarget.Worksheets(f.Name)  
24.
	            If Err <> 0 Then  
25.
	                Set ws = wbTarget.Worksheets.Add  
26.
	                ws.Name = f.Name  
27.
	                ws.Range("A:ZZ").Clear  
28.
	            End If  
29.
	            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True  
30.
	            wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")  
31.
	            wbSource.Close False 
32.
	        End If 
33.
        End If  
34.
    Next  
35.
    Set ts = wbTarget.Worksheets("Zusammenfassung")  
36.
    Dim curCell As Range  
37.
    Set curCell = ts.Range("A1")  
38.
    For i = 1 To wbTarget.Worksheets.Count - 1  
39.
        maxRow = wbTarget.Worksheets(i).Range("A1").End(xlDown).Row  
40.
        maxCol = wbTarget.Worksheets(i).Range("A1").End(xlToRight).Column  
41.
        wbTarget.Worksheets(i).Range(wbTarget.Worksheets(i).Cells(1, 1), wbTarget.Worksheets(i).Cells(maxRow, maxCol)).Copy Destination:=curCell  
42.
        Set curCell = curCell.End(xlDown).Offset(2, 0)  
43.
    Next  
44.
Application.DisplayAlerts = True  
45.
    Set fso = Nothing  
46.
End Sub
Gruß jodel32
Bitte warten ..
Mitglied: sunshine89
13.10.2014 um 12:53 Uhr
Vielen Dank für deine schnelle Antwort jodel32.
Haben den Code bei mir jetzt so übernommen, bekomme jedoch die Fehlermeldung "Laufzeitfehler13 Typen unverträglich"
habe nur den Pfad angepasst und die Start und End-Daten
Bitte warten ..
Mitglied: 114757
LÖSUNG 13.10.2014, aktualisiert um 14:04 Uhr
hier läufts, hast wahrscheinlich CSV-Dateien in deinem Ordner liegen die nicht deinem angegebenen Format (Datensatz_YYYYMMDD.csv) entsprechen ...
Bitte warten ..
Mitglied: sunshine89
13.10.2014 um 13:40 Uhr
ups habe gerade festgestellt, dass der Dateiname insgesamt 4 mal "_" enthält und erst nach dem vierten das Datum kommt.
Bitte warten ..
Mitglied: 114757
LÖSUNG 13.10.2014, aktualisiert um 14:04 Uhr
Zitat von sunshine89:

ups habe gerade festgestellt, dass der Dateiname insgesamt 4 mal "_" enthält und erst nach dem vierten das Datum
kommt.
OK dann konnte es natürlich nicht laufen, ist oben dahingehend korrigiert, nimmt jetzt an, das das Datum immer am Ende steht.
Bitte warten ..
Mitglied: sunshine89
13.10.2014 um 14:03 Uhr
Vielen Vielen Dank jetzt läuft es
Hab es aber auch so hinbkommen, dass ich einfach "arrBasename(4)" anstatt "arrBasename(1)" gesetzt hab.
Bitte warten ..
Mitglied: 116301
14.10.2014 um 11:09 Uhr
Hallo zusammen!

Der Beitrag ist zwar schon gelöst, aber hier noch eine vereinfachte (Direkt-Import)-Variante mit erheblichem Geschwindigkeitsvorteil...

Unter der Annahme, das die Mappe nur ein Sheet (Zusammenfassung) enthält bzw. die Daten in Sheet(1) importiert werden sollen.
01.
Option Explicit 
02.
 
03.
Private Const CsvPath = "E:\Csv-Dateien" 
04.
 
05.
Private Const DateBeg = "01.10.2014" 
06.
Private Const DateEnd = "15.10.2014" 
07.
 
08.
Public Sub ImportiereCSVDateien() 
09.
    Dim oFso As Object, oFile As Object, oTarget As Range, sDate As String, dDate As Date 
10.
     
11.
    Sheets(1).UsedRange.Clear 
12.
    Set oTarget = Sheets(1).Range("A1") 
13.
     
14.
    Set oFso = CreateObject("Scripting.FileSystemObject") 
15.
     
16.
    Application.ScreenUpdating = False 
17.
     
18.
    For Each oFile In oFso.GetFolder(CsvPath).Files 
19.
        If LCase(oFso.GetExtensionName(oFile.Name)) = "csv" Then 
20.
            sDate = Right(oFso.GetBaseName(oFile.Name), 8) 
21.
            dDate = CDate(Right(sDate, 2) & "." & Mid(sDate, 5, 2) & "." & Left(sDate, 4)) 
22.
         
23.
            If dDate >= CDate(DateBeg) And dDate <= CDate(DateEnd) Then 
24.
                Call GetCsvData(oFile.Path, oTarget) 
25.
                Set oTarget = oTarget.End(xlDown).Offset(2, 0) 
26.
            End If 
27.
        End If 
28.
    Next 
29.
     
30.
    Application.ScreenUpdating = True 
31.
End Sub 
32.
 
33.
Private Sub GetCsvData(ByRef sFileName, ByRef oTarget As Range) 
34.
    With Sheets(1).QueryTables.Add(Connection:="Text;" & sFileName, Destination:=oTarget) 
35.
        .AdjustColumnWidth = False 
36.
        .TextFileParseType = xlDelimited 
37.
        .TextFileSemicolonDelimiter = True 
38.
        .TextFileTextQualifier = xlTextQualifierDoubleQuote 
39.
        .Refresh BackgroundQuery:=False 
40.
        .Delete 
41.
    End With 
42.
End Sub
Grüße Dieter
Bitte warten ..
Ähnliche Inhalte
VB for Applications

Mehrere CSV-Dateien mit einem VBA Makro einlesen und automatisch verarbeiten

Frage von armini92VB for Applications3 Kommentare

Hallo! Ich schreibe gerade meine Bachelorarbeit und bekomme täglich zahlreiche Messergebnisse im CSV-Format ausgegeben. Diese muss ich manuell konvertieren, ...

Microsoft Office

Alle CSV-Dateien mit neuem Datum in einem Ordner mit einem VBA Makro einlesen

Frage von parlermo2102Microsoft Office1 Kommentar

Hallo ich habe ein Problem Mit Makro ich möchte 2 CSV dateien per Makro einlesen SetMontageExport-DGS-16-04-11.csv SetMontageExport-NDGS-16-04-11.csv wie bekomme ...

Microsoft Office

CSV-Datei mit einem VBA Makro in Excel einlesen und leicht anpassen

gelöst Frage von JoSiBaMicrosoft Office5 Kommentare

Hallo zusammen, ich benutze folgenden Code von Colinardo: Die Importierung an sich Funktioniert. Ich habe hier nur 4 Anliegen. ...

VB for Applications

Mehrere CSV Dateien aus verschiedenen Ordner einlesen via VBA

gelöst Frage von mtufangilVB for Applications12 Kommentare

Hallo Zusammen, ich bin ein absoluter VBA Neuling und versuche etwas umzusetzen, leider komme ich nicht weiter. Ich hoffe ...

Neue Wissensbeiträge
Sicherheit
Sicherheitsrisiko: Die Krux mit 7-Zip
Information von kgborn vor 1 StundeSicherheit

Bei vielen Anwendern ist das Tool 7-Zip zum Entpacken von Archivdateien im Einsatz. Die Software ist kostenlos und steht ...

Internet

Datendealing im WWW Tracking Methoden immer brutaler

Information von sabines vor 10 StundenInternet

Interessanter Artikel zum Thema Tracking im WWW und die immer "besseren" Methoden des Trackings. Professor Arvind Narayanan (Princeton-Universität) betreibt ...

Erkennung und -Abwehr

Ups: Einfaches Nullzeichen hebelte den Anti-Malware-Schutzt in Windows 10 aus

Information von kgborn vor 22 StundenErkennung und -Abwehr

Windows 10 ist das sicherste Windows aller Zeiten, wie Microsoft betont. Insidern ist aber klar, das es da Lücken, ...

Windows 10

Windows 10 on ARM: von Microsoft entfernte Info - Klartext, was nicht geht

Information von kgborn vor 1 TagWindows 10

Windows 10 on ARM ist ja eine neue Variante, die Microsoft im Verbund mit Geräteherstellern am Markt etablieren will. ...

Heiß diskutierte Inhalte
Server
Route-Befehl Unterstützung (unter CMD)
gelöst Frage von FKRR56Server36 Kommentare

Guten Tag , i.M. habe ich Probleme über den CMD-Route-Befehl ein Routing auf einen entfernten Server zuzulassen. Der Server ...

Windows 10
Windows 10 (1709) Tastur und Maus wieder einschalten?
Frage von LochkartenstanzerWindows 1028 Kommentare

Moin, Ich habe von einem Kunden einen Win10-Rechner bekommen, bei dem weder Tastatur noch Maus geht. Die Hardware funktioniert ...

Microsoft
TV-Tipp: Das Microsoft-Dilemma
Information von kgbornMicrosoft17 Kommentare

Aktuell gibt es in Behörden und in Firmen eine fatale Abhängigkeit von Microsoft und dessen Produkten. Planlos agieren die ...

Firewall
RB2011 Firewall Rule eine bestimmte Mac oder IP Adresse nicht zu blockieren
Frage von lightmanFirewall15 Kommentare

Hallo liebes Forum mit ihren Spezialisten. Ich habe meine Firewall so konfiguriert das kein Endgerät ohne meine Speziellen Erlaubnis ...