VBA

Hey,

was mir grad auffällt, vllt könnte man analog zum java-forum auch eins für VBA machen =)

mein prob ist folgendes. ich bräuchte ein makro, dass mir diverse dateien importiert und als xls abspeichert.
das ganze könnte ich natürlich easy mitm aufzeichnungs-assi machen, dass mir aber auch zu lame.

leider funzt aber irgendwas bei mir net richtig, und da ich auch nur ab und zu mal was mit vba mache, komm ich nicht dahinter, was ...

ich möchte als aus 1 ordner, dass alle dort enthaltenen csv-dateien nacheinander in ein neues dokument importiert werden (UTF-8, ;-getrennt) und dies dann in nem neu angelgten ordner als xls gespeichert wird.

folgendes habe ich schon, aber es läuft nicht:

Zitat

Sub Langzeitkranke()
'
' Langzeitkranke Makro
' Makro am 19.10.2009 von plutod aufgezeichnet
'

'
Application.DisplayAlerts = False
If Not FolderExists("Y:\18000_Syst_Tools_IOM_Rep_Auth\18100_Key_Topics\18150_Reporting\18152_Monthly_Reports\Langzeitkranke\" & Format(CDate(Day(Now) & "." & Month(Now) & "." & Year(Now)), "YYYY MM") & "\") Then MkDir "Y:\18000_Syst_Tools_IOM_Rep_Auth\18100_Key_Topics\18150_Reporting\18152_Monthly_Reports\Langzeitkranke\" & Format(CDate(Day(Now) & "." & Month(Now) & "." & Year(Now)), "YYYY MM") & "\"

Dim sFile As String, sPattern As String, sPath As String
Dim iRow As Integer
sPath = "Y:\" ' Hier gibst Du Deinen Pfand zum gewünschten Verzeichnis an
sPathNew = "Y:\" & Format(CDate(Day(Now) & "." & Month(Now) & "." & Year(Now)), "YYYY MM") & "\"
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sPattern = "*.csv"
sFile = Dir(sPath & sPattern)

Do Until sFile = ""
iRow = iRow + 1

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;sPath & sFile" _
, Destination:=Range("A1"))
.Name = "bem"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = -535
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True

End With

ChDir sPathNew
ActiveWorkbook.SaveAs Filename:= _
sPathNew & Left(sFile, Len(sFile) - 3) & "xls" _
, FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close

sFile = Dir()
Loop

Application.DisplayAlerts = True

End Sub

Alles anzeigen

einige Fehler konnte ich schon beheben, aktuell hängt das Teil hier: "TEXT;sPath & sFile" _

das ganze wäre natürlich die alternative und mir pers. auch recht ... ich hatte auch schon die umwandlung von csv nach xls programmiert, bis mir leider aufgefallen ist, dass am ende die zeichencodierung nicht stimmte (die umlaute werden in Hieroglyphen angezigt).

in autoit ist mir leider nicht bekannt, wie ich das problem beheben soll. was haste denn dafür anzubieten *g*

hey,

habs mal als au3 hochgeladen. benenn das teil in csv um, dann ist es das, was ich rausbekomme.
sind nur die überrschriften, aber da ist schon ein umlaut drin.

wenn ich es in excel importiere, wähle ich "Unicode (UTF-8)" aus.