Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

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

Frage Entwicklung VB for Applications

Mitglied: sunshine89

sunshine89 (Level 1) - Jetzt verbinden

13.10.2014 um 11:52 Uhr, 944 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: Eintagsfliege
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 ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(8)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
VB for Applications
gelöst Mehrere CSV Dateien aus verschiedenen Ordner einlesen via VBA (12)

Frage von mtufangil zum Thema VB for Applications ...

VB for Applications
gelöst Wie mittels VBA beim Import von CSV dateien das Format aller Zellen auf "Zahl" ändern? (2)

Frage von Glibber4 zum Thema VB for Applications ...

VB for Applications
gelöst VBA - viele CSV Dateien in ein Excel sheet (2)

Frage von LordY6 zum Thema VB for Applications ...

Heiß diskutierte Inhalte
Microsoft
Ordner mit LW-Buchstaben versehen und benennen (21)

Frage von Xaero1982 zum Thema Microsoft ...

Netzwerkmanagement
gelöst Anregungen, kleiner Betrieb, IT-Umgebung (18)

Frage von Unwichtig zum Thema Netzwerkmanagement ...

Windows Update
Treiberinstallation durch Windows Update läßt sich nicht verhindern (17)

Frage von liquidbase zum Thema Windows Update ...