Anzeige
Archiv - Navigation
864to868
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
864to868
864to868
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Ziel speichern unter im bestimmten Ordner

Ziel speichern unter im bestimmten Ordner
27.04.2007 08:33:00
Thommy
Guten Morgen Forum,
ich hab ein kleines anliegen:
Ich füge mit folgenden Code meherere CSV-Files in einem Verzeichnis zu einer Excel-Datei zusammen.

Private Sub Zusammenführen_Click()
Dim FS As Object, oFolder As Object, oFile As Object
Dim vntTemp, strTemp As String
Dim wkbCSV As Workbook, wksCSV As Worksheet
Dim blnHeader As Boolean, blnFirstRow As Boolean
Dim strCsvPath As String, strDateiName As Variant
Dim lngLastRow As Long
Const strDelim As String = ";"   'Trennzeichen
'Ordner wählen
With Application.FileDialog(4)
.InitialFileName = "Q:\Excel_Test"
.InitialView = 2
.Title = "Bitte einen Ordner wählen"
If .Show = -1 Then
strCsvPath = .SelectedItems(1)
End If
End With
If strCsvPath = "" Then Exit Sub
If Dir(strCsvPath & "\*.csv", vbNormal) = "" Then
MsgBox "Keine .CSV im Ordner."
Exit Sub
End If
Set wkbCSV = Workbooks.Add(1)
Set wksCSV = wkbCSV.Sheets(1)
wksCSV.Cells.Clear
Set FS = CreateObject("scripting.filesystemobject")
Set oFolder = FS.getfolder(strCsvPath)
For Each oFile In oFolder.Files
If oFile.Name Like "*.csv" Then
Open oFile For Input As #1
blnFirstRow = True
Do While Not EOF(1)
Line Input #1, strTemp
vntTemp = Split(strTemp, strDelim)
With wksCSV
If UBound(vntTemp) > -1 Then
If blnHeader = False Or blnFirstRow = False Then
.Range(.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0), .Cells(Rows.Count, 1). _
_
End(xlUp).Offset(1, UBound(vntTemp))) = vntTemp
blnHeader = True
End If
End If
End With
blnFirstRow = False
Loop
Close 1
End If
Next oFile
Set oFolder = Nothing
Set FS = Nothing
With wksCSV
.Rows(1).Delete
lngLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Columns(3).Insert Shift:=xlToRight
.Range("C1") = "FILTER_TYP"
.Range(.Cells(2, 3), .Cells(lngLastRow, 3)).FormulaR1C1 = "=MID(RC[-1],7,5)"
.Range(.Cells(2, 3), .Cells(lngLastRow, 3)) = .Range(.Cells(2, 3), .Cells(lngLastRow, 3)). _
_
Value
.Name = "Gesamt_CSV"
End With
'Datei speichern
strDateiName = Application.GetSaveAsFilename("Gesamt_CSV", "Microsoft-Excel Arbeitsmappe (*. _
xls),*.xls", , "Datei speichern unter")
If strDateiName  False Then wkbCSV.SaveAs strDateiName
End Sub


Dabei öffnet sich wenn ich das Makro startet das Fenster in dem ich dieses Verezeichnis auswähle. Hab ich das getan fügt er sie zusammen. Danach öffnet er das Fenster "Speichern unter".
Und ich hätte jetzt gerne dass er in diesem Fenster mir immer einern bestimmten Ordner anzeigt in dem ich das File reinspeichern möchte. Z.b. im Ordner "C:\Gesamt_CSV\". Das erspart diese ständige auswählerei des Ordners.
Ist das überhaupt möglich? habe leider 0 Ahnung von VBA...
Vielen Dank für eure Hilfe!! ;-)
__________________
Schöne Grüße
Thommy

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ziel speichern unter im bestimmten Ordner
27.04.2007 08:50:13
Oberschlumpf
Hi Thommy
ersetz mal deinen Code ab - 'Datei speichern - durch diesen (ungetestet):

'Datei speichern
Dim lstrPfad As String
lstrPfad = Dir("C:\Gesamt_CSV", vbDirectory)
If lstrPfad   "" Then
ChDrive("C:")
ChDir("C:\" & lstrPfad)
End If
strDateiName = Application.GetSaveAsFilename("Gesamt_CSV", "Microsoft-Excel Arbeitsmappe (*.  _
_
xls),*.xls", , "Datei speichern unter")
If strDateiName  False Then wkbCSV.SaveAs strDateiName


Konnte ich helfen?
Ciao
Thorsten

AW: Ziel speichern unter im bestimmten Ordner
27.04.2007 09:03:00
Thommy
Hi Thorsten!
Wunderbar :-)
Danke schön, funktioniert!!
LG
Thommy
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige