Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
CSV Dateien importieren mit Zeitstempeln |
31.05.2016 17:22:00 |
Clemens Hortmann |
|
|
|
31.05.2016 17:40:05 |
Clemens |
|
|
|
31.05.2016 17:47:39 |
Gast52933 |
|
|
Von:
Clemens Hortmann |
Datum:
31.05.2016 17:22:00 |
Views:
1442 |
Rating:
|
Antwort:
|
Thema:
CSV Dateien importieren mit Zeitstempeln |
Hallo,
ich bin neu hier im Forum und habe ein kleines Problem beim Import von CSV Dateien. Ich habe ein kleines Makro geschrieben, welches unter Abfrage eines bestimmten Ordners, mir alle CSV Dateien des ausgewählten Pfads in Excel importiert und in einer Datei in jeweils einzelne Tabellenblätter ablegt. Das Makro funktioniert auch absolut zuverlässig.
Leider habe ich in der ersten Spalte einen Zeitstempel hinterlegt, den Excel nach dem Import nicht mehr als solchen akzeptiert. Dies ist allerdings wichtig, da ich mit der Funktion mehrere Tabellen zusammenfügen, die später in Diadem über der Zeit ausgewertet werden sollen.
Hier ein Beispiel für meine Rohdaten:
16.07.2012 14:27:23;3,9169177;48,7296286;13,59;0;1200;0;0;0;0,1;0;0;aus
Nachfolgend habe ich meinen Code mit angefügt. Ich würde mich freuen, wenn mir einer bei meinem Problem helfen könnte.
Sub ImportiereCSVDateien()
Dim ordner
Dim dat
Set dat = Application.FileDialog(msoFileDialogFolderPicker)
With dat
.Title = "Netzwerk...."
.InitialFileName = "I:\cse-val-abteilungen\04_Prüfstände\Antriebsprüfstand Merlin 2\Prüfkollektive\Telematics\" 'oder was auch immer
If .Show = -1 Then ordner = .SelectedItems(1) 'Zur weiteren verwendung
MsgBox ordner
End With
CSVPFAD = ordner
Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet
Set fso = CreateObject("Scripting.Filesystemobject")
Set wbTarget = ActiveWorkbook
Application.DisplayAlerts = False
'Lösche alle Worksheets bevor wir alle neu anlegen
If wbTarget.Worksheets.Count > 1 Then
For i = 1 To wbTarget.Worksheets.Count - 1
wbTarget.Worksheets(i).Delete
Next
End If
For Each f In fso.GetFolder(CSVPFAD).Files
If LCase(Right(f.Name, 3)) = "csv" Then
Workbooks.OpenText Filename:=f.Path
Set wbSource = ActiveWorkbook
On Error Resume Next
Set ws = wbTarget.Worksheets(f.Name)
If Err <> 0 Then
Set ws = wbTarget.Worksheets.Add
ws.Name = f.Name
ws.Range("A:ZZ").Clear
End If
wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True
wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")
wbSource.Close False
End If
Next
Application.DisplayAlerts = True
Set fso = Nothing
Sheets("Formeln").Select
Range("A1").Select
MsgBox "fertig"
End Sub
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
CSV Dateien importieren mit Zeitstempeln |
31.05.2016 17:22:00 |
Clemens Hortmann |
|
|
|
31.05.2016 17:40:05 |
Clemens |
|
|
|
31.05.2016 17:47:39 |
Gast52933 |
|
|