Verkrüppelte Zeichen Webabfrage

Sub test() connectionString = "URL;http://maps.google. _ com/maps/geo?q=ltu arena germany" With ActiveSheet.QueryTables.Add(Connection:=connectionString _ , Destination:=Range("A1")) .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .RefreshPeriod = 0 .WebSelectionType = xlEntirePage .WebFormatting = xlWebFormattingNone .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .Refresh BackgroundQuery:=False End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
hier mal eine andere Möglichkeit.
Zuerst die Datei Lokal Downloaden,
danach mit dem richtigen Zeichensatz (Unicode(UTF-8) einlesen und
die Datei am ende wieder löschen.

Option Explicit

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
   "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
   ByVal szFileName As String, ByVal dwReserved As Long, _
   ByVal lpfnCB As Long) As Long


Sub test()
Dim sURL As String, sFile As String
Dim F As Integer
Dim sInhalt As String
Dim myArea

sURL = "http://maps.google.com/maps/geo?q=ltuarena germany"

sFile = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
sFile = sFile & "Webdata.txt"

URLDownloadToFile 0, sURL, sFile, 0, 0
Columns(1).Value = ""
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sFile, _
        Destination:=Range("A1"))
        .Name = "geo"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = -535
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        Tabelle1.QueryTables(1).Delete
    End With
Kill sFile 'Datei löschen 

End Sub

Gruß Tino

Public Sub Umschluesseln() With Worksheets("Tabelle3").Range("B2") .Value = "Ã¤Ã¶Ã¼ÃÃÃÃ" Worksheets("Tabelle3").Range("B3").Value = .Value MsgBox "Bitte in Tabelle3 die Zelle B2 ansehen.", _ 64, " Hinweis für " & Application.UserName .Value = Replace(.Value, "Ã¤", "ä") .Value = Replace(.Value, "Ã¶", "ö") .Value = Replace(.Value, "Ã¼", "ü") .Value = Replace(.Value, "Ã", "ß") .Value = Replace(.Value, "Ã", "Ä") .Value = Replace(.Value, "Ã", "Ö") .Value = Replace(.Value, "Ã", "Ü") MsgBox GetUTF8String(.Value) End With End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread