UTF-8 code
07.11.2012 08:53:09
Pepi
Sub SU_Excel_to_Text()
Dim iFilNum As Integer, z As Long, sNam As String, sAdr As String, sTel As String, sOut As _
String
iFilNum = FreeFile
Tab05.Activate
sOut = ThisWorkbook.Path & "\Testfile-" & Format(Now, "yymmdd-hhmm") & ".vcf"
Open sOut For Output As #iFilNum
For z = 1 To 20
sNam = Trim(Cells(z, 2) & " " & Cells(z, 3))
sAdr = Trim(Cells(z, 6) & " " & Cells(z, 7))
sTel = Cells(z, 9)
Print #iFilNum, Join(Array(sNam, sAdr, sTel), ";")
Next
Workbooks(sOut).Activate 'Fehler "Index ausserhalb des gültigen Bereichs"
With Application.DefaultWebOptions 'mit Makrorecorder aufgenommen
.RelyOnCSS = True
.OrganizeInFolder = True
.UseLongFileNames = True
.DownloadComponents = False
.RelyOnVML = False
.AllowPNG = True
.ScreenSize = msoScreenSize1024x768
.PixelsPerInch = 96
.Encoding = msoEncodingUTF8
End With
With Application.DefaultWebOptions
.SaveHiddenData = True
.LoadPictures = True
.UpdateLinksOnSave = True
.CheckIfOfficeIsHTMLEditor = True
.AlwaysSaveInDefaultEncoding = False
.SaveNewWebPagesAsWebArchives = True
End With
Workbooks(sOut).Save 'Fehler "Index ausserhalb des gültigen Bereichs"
Close #iFilNum
End Sub
vielen Dank
Pepi