jerry0110
Erfahrenes Mitglied
So nachdem ich jetzt 2 Fragen selber beantworten konnte, stehe ich jetzt auf dem Schlauch.
Ich habe jetzt meine Exporte als CSV gespeichert und diese werden durch einen Loop in Excel umgewandelt.
Jetzt möchte ich diese Datei die gerade umgewandelt wurde öffnen und dann formatieren.
Hier noch mal der Code für die Umwandlung in Excel:
Das formatieren habe ich schon fertig. Nur bekomme ich das Öffnen der Datei einfach nicht hin.
Und danach soll dann entsprechend eine Email mit dem formatierten Anhang verschickt werden.
Ich habe jetzt meine Exporte als CSV gespeichert und diese werden durch einen Loop in Excel umgewandelt.
Jetzt möchte ich diese Datei die gerade umgewandelt wurde öffnen und dann formatieren.
Hier noch mal der Code für die Umwandlung in Excel:
Visual Basic:
Option Explicit
Private Function xlsGetLastRow(ByRef sheet As Object) As Long
Const xlCellTypeLastCell = 11
'Zur letzten initialisierten Zeile gehen
xlsGetLastRow = sheet.Cells.SpecialCells(xlCellTypeLastCell).Row
'Von dort zurücksuchen bis zur Letzten zeile mit Inhalt
Do While sheet.Application.WorksheetFunction.CountA(sheet.Rows(xlsGetLastRow)) = 0 And xlsGetLastRow > 1
xlsGetLastRow = xlsGetLastRow - 1
Loop
End Function
Private Function lastRowNr(ByRef ws As Worksheet)
lastRowNr = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
End Function
Public Function xlsGetLastColumn(ByRef sheet As Object) As Long
Const xlCellTypeLastCell = 11
'Zur letzten initialisierten Zeile gehen
xlsGetLastColumn = sheet.Cells.SpecialCells(xlCellTypeLastCell).Column
'Von dort zurücksuchen bis zur Letzten zeile mit Inhalt
Do While sheet.Application.WorksheetFunction.CountA(sheet.Columns(xlsGetLastColumn)) = 0 And xlsGetLastColumn > 1
xlsGetLastColumn = xlsGetLastColumn - 1
Loop
End Function
Private Function datum() As Date
If Weekday(Date, vbMonday) = 1 Then
datum = Date - 3
Else
datum = Date - 1
End If
End Function
Sub CSV_Woechentlich_erstellen()
Dim source As Worksheet
Dim LastRowNrSource As Long
Dim f
Set source = ThisWorkbook.Worksheets("Tabelle1")
'letzte Ziele im Ziel berechnen
LastRowNrSource = lastRowNr(source)
For f = lastRowNr(source) To 1 Step -1
If source.Range("E" & f) = "1x pro Woche" Then
Dim sFile As String, sPath As String, iFree As Integer
Dim arrCSV, arrTmp, arrXLS(), i As Long, j As Integer, n As Long
Dim zFile As String
sPath = source.Range("B2") & source.Range("G" & f) 'anpassen
sFile = Dir(sPath & "*.csv")
zFile = "Report"
Application.ScreenUpdating = False
Do While Len(sFile)
iFree = FreeFile
Open sPath & sFile For Input As iFree
arrCSV = Split(Input(LOF(iFree), iFree), vbCrLf)
Close iFree
For i = 0 To UBound(arrCSV)
arrTmp = Split(arrCSV(i), ";")
n = Application.Max(n, UBound(arrTmp))
Next
ReDim arrXLS(1 To UBound(arrCSV) + 1, 1 To n + 1)
For i = 0 To UBound(arrCSV)
arrTmp = Split(arrCSV(i), ";")
For j = 0 To UBound(arrTmp)
arrXLS(i + 1, j + 1) = arrTmp(j)
Next
Next
With Workbooks.Add
.Sheets(1).Cells(1, 1).Resize(UBound(arrXLS), UBound(arrXLS, 2)) = arrXLS
.SaveAs sPath & Mid(zFile, 1, Len(sFile) - 4)
.Close
End With
sFile = Dir
Loop
LastRowNrSource = LastRowNrSource + 1
End If
Next f
End Sub
Das formatieren habe ich schon fertig. Nur bekomme ich das Öffnen der Datei einfach nicht hin.
Und danach soll dann entsprechend eine Email mit dem formatierten Anhang verschickt werden.