AW: *.CSV Dateien mit Semikolon trennen beim Speichern
23.05.2007 15:50:24
Rudi
Hallo,
eine Möglichkeit:
Sub test()
Dim datum As String
Dim lw As String
Dim pf As String
Dim b1 As String, b2 As String, b3 As String, b4 As String, b5 As String, b6 As String, b7 _
As String
Dim s1 As String, s2 As String, s3 As String, s4 As String, s5 As String, s6 As String, s7 _
As String
Dim outl As Object, mail As Object
Set outl = CreateObject("outlook.application")
Set mail = outl.createitem(olmailitem)
b1 = "_ges_lhwsrebib.csv"
b2 = "_telek_lhwsrebib.csv"
b3 = "_teleb_lhwsrebib.csv"
b4 = "_eng_lhwsrebib.csv"
b5 = "_ch_lhwsrebib.csv"
b6 = "_katb_lhwsrebib.csv"
b7 = "_sonst_lhwsrebib.csv"
s1 = Range("f61").Value
s2 = Range("f62").Value
s3 = Range("f63").Value
s4 = Range("f64").Value
s5 = Range("f65").Value
s6 = Range("f66").Value
s7 = Range("f67").Value
lw = "N:\"
pf = "N:\ZB_Erreichbarkeiten\VS\Philippsen\BerichtePHILIPPSEN\2007"
datum = Range("h23").Value
ChDrive lw
ChDir pf
Application.ScreenUpdating = False
On Error GoTo fehler
Workbooks.Open Filename:="testReportIB2007.xls"
With ActiveWorkbook
AlsTextSpeichern .Sheets("Gesamt"), datum & b1
AlsTextSpeichern .Sheets("Telekauf"), datum & b2
AlsTextSpeichern .Sheets("Telebetreuung"), datum & b3
AlsTextSpeichern .Sheets("Englisch"), datum & b4
AlsTextSpeichern .Sheets("Swiss"), datum & b5
AlsTextSpeichern .Sheets("Katalogbestellung"), datum & b6
AlsTextSpeichern .Sheets("sonstiges"), datum & b7
.Close True
End With
Application.ScreenUpdating = False
With mail
.Subject = "testFTP Upload " & Date
.body = ""
.To = "test@walterservices.com"
.attachments.Add s1
.attachments.Add s2
.attachments.Add s3
.attachments.Add s4
.attachments.Add s5
.attachments.Add s6
.attachments.Add s7
.send
End With
Set outl = Nothing
Set mail = Nothing
Run "test2"
Exit Sub
fehler: MsgBox "Bitte Eingabe überprüfen"
End Sub
Sub AlsTextSpeichern(TB As Worksheet, strFile As String)
Dim Dateinummer%
Dim z%, s%, exportfile$, TMP$
Dateinummer = FreeFile
Open strFile For Output As #Dateinummer
With TB
For z = 1 To .UsedRange.Rows.Count
If .Cells(z, 2).Value = Text Then SL = 10 Else SL = 6
For s = 1 To .UsedRange.Columns.Count
TMP = TMP & CStr(.Cells(z, s).Text) & ";"
Next s
TMP = Left(TMP, Len(TMP) - 1)
Print #Dateinummer, TMP
TMP = ""
Next z
End With
Close #Dateinummer
End Sub
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe