URL Decodierung in Excel

[DeLaGhetto]

Hallo zusammen,
ich nehmen Bezug auf dieses Thema hier (zumindest die letzten 2 Post):

http://www.clever-excel-forum.de/Thread-...ren?page=3

Ich habe eine Internetseite, die kyrillische Buchstaben hat. Wenn ich die URL dieser Internetseite kopiere, dann wird die URL extrem lang kodiert, sodass ich nicht mehr vernünftig mit der Internetseite arbeiten kann.
Ich möchte diese kodierte URL wieder decodieren.

Nach längerem suchen bin ich dann auf follgende Internetseite gestoßen:

http://www.andre-jochim.de/url-encode.htm

Damit kann ich diesen Link:

Code:

https://www.jw.org/ru/%D0%BF%D1%83%D0%B1%D0%BB%D0%B8%D0%BA%D0%B0%D1%86%D0%B8%D0%B8/%D1%81%D0%B2%D0%B8%D0%B4%D0%B5%D1%82%D0%B5%D0%BB%D0%B5%D0%B9-%D0%B8%D0%B5%D0%B3%D0%BE%D0%B2%D1%8B-%D0%B2%D1%81%D1%82%D1%80%D0%B5%D1%87%D0%B0-%D1%80%D0%B0%D0%B1%D0%BE%D1%87%D0%B0%D1%8F-%D1%82%D0%B5%D1%82%D1%80%D0%B0%D0%B4%D1%8C/%D0%BD%D0%BE%D1%8F%D0%B1%D1%80%D1%8C-2017-mwb/%D1%80%D0%B0%D1%81%D0%BF%D0%B8%D1%81%D0%B0%D0%BD%D0%B8%D0%B5-%D0%B2%D1%81%D1%82%D1%80%D0%B5%D1%87%D0%B8-6-12%D0%BD%D0%BE%D1%8F%D0%B1/

wieder so decodieren, dass ich ihn kopieren kann und vernünftig in excel einbinden kann und damit weiterarbeiten kann.


Kann Excel die URL auch von sich aus decodieren?
Ich habe einen Code gefunden, der wohl das für mich erledigen soll, allerdings verstehe ich nicht wirklich, wie ich ihn anwenden soll.

Code:

Public Function URLEncode(StringToEncode As String, Optional _
   UsePlusRatherThanHexForSpace As Boolean = False) As String

Dim TempAns As String
Dim CurChr As Integer
CurChr = 1
Do Until CurChr - 1 = Len(StringToEncode)
  Select Case Asc(Mid(StringToEncode, CurChr, 1))
    Case 48 To 57, 65 To 90, 97 To 122
      TempAns = TempAns & Mid(StringToEncode, CurChr, 1)
    Case 32
      If UsePlusRatherThanHexForSpace = True Then
        TempAns = TempAns & "+"
      Else
        TempAns = TempAns & "%" & Hex(32)
      End If
   Case Else
         TempAns = TempAns & "%" & _
              Format(Hex(Asc(Mid(StringToEncode, _
              CurChr, 1))), "00")
End Select

  CurChr = CurChr + 1
Loop

URLEncode = TempAns
End Function


Public Function URLDecode(StringToDecode As String) As String

Dim TempAns As String
Dim CurChr As Integer

CurChr = 1

Do Until CurChr - 1 = Len(StringToDecode)
  Select Case Mid(StringToDecode, CurChr, 1)
    Case "+"
      TempAns = TempAns & " "
    Case "%"
      TempAns = TempAns & Chr(Val("&h" & _
         Mid(StringToDecode, CurChr + 1, 2)))
       CurChr = CurChr + 2
    Case Else
      TempAns = TempAns & Mid(StringToDecode, CurChr, 1)
  End Select

CurChr = CurChr + 1
Loop

URLDecode = TempAns
End Function


' URLDecode function in Perl for reference
' both VB and Perl versions must return same
'
' sub urldecode{
'  local($val)=@_;
'  $val=~s/\+/ /g;
'  $val=~s/%([0-9A-H]{2})/pack('C',hex($1))/ge;
'  return $val;
' }

Den Code habe ich von dieser Seite

http://www.freevbcode.com/ShowCode.asp?ID=1512

Allerdings verstehe ich nicht, wie ich diesen Code vernünftig anwenden kann...

Hoffe jemand kann mir helfen

[Helvetier]

Hallo DeLaGhetto
Ich habe den von Dir gelieferten Code angewendet. Resultat:
'''https://www.jw.org/ru/публикации/свидетелей-иеговы-встреча-рабочая-тетрадь/ноябрь-2017-mwb/расписание-встречи-6-12нояб/


Bei der Handeingabe in die Editierzeile führt er nicht an denselben Ort, wie der Originalcode. Kannst selber probieren (aber vorher die Hochkommata löschen).
Er ist 193 Zeichen lang gegenüber 489 Zeichen beim Originalcode.

In dem Makro das ich Dir geliefert habe ist er auch noch zu lang: funktioniert also nicht.

Wir haben also 2 Probleme (die da sind, um gelöst zu werden):
- Der Verkürzungscode taugt nicht.
- Im Makro Sub DatenAusWeb() sind 193 Zeichen zu viel. Wie viel es sein dürfen ist offen.
Also weitersuchen!

Gedanke: Statt die URL mit irgend welchen Codes zu malträtieren, könnte man doch mit sendkys oder so die Adresse in die Editierzeile kopieren. Wie das machbar ist, ist mir zur Zeit verschlossen (andere Applikation).

[Helvetier]

Also damit kann ich schon mal die Seite mit dem Originalcode ansprechen:
Quelle: '''https://www.mrexcel.com/forum/excel-questions/662469-vba-using-sendkeys-internet-explorer.html[url=https://www.mrexcel.com/forum/excel-questions/662469-vba-using-sendkeys-internet-explorer.html][/url]

Code:

Sub Tes()
   Dim Adresse

   Dim IE As Object
   Dim TrackID As Object
   
   On Error Resume Next
   Adresse = Sheets("Plan").Range("C29")
   Set IE = CreateObject("InternetExplorer.Application")
   IE.navigate Adresse
   IE.Visible = True
   
   'IE.navigate "https://aviationcargo.dhl.com/webedit/ACGRegions.asp?WebSite=US&page=multi%20MAWB&lang=EN"
   'Do Until IE.readystate = 4: DoEvents: Loop
   'Set TrackID = IE.document.getelementbyid("trackinginput")
   'TrackID.Value = Range("A2").Value
   'TrackID.form.submit
End Sub

Was ist nun genau zu importieren?

[DeLaGhetto]

Meinst du welche Internetseite zu importieren ist?

[Helvetier]

Meinst du welche Internetseite zu importieren ist?

Willst Du den gesamten Inhalt dieser Seite oder nur bestimmte Elemente?
Und ist es überhaupt die richtige Seite? Funktioniert das Ding auch mit andern URL, die Du vor hast, anzusprechen? Das solltest Du nun schon probieren!: Ein Versuch ist kein Versuch.

[DeLaGhetto]

Den gesammten Inhalt

[Helvetier]

Hallo DeLaGhetto
Mit unten aufgeführtem Code kann ich:
- die russische Site ansprechen
- wie man die Zelladresse einbaut habe ich bereits gezeigt
- die Daten werden für www.excel-clever ....in den Direktbereich ausgegeben (die Russenadresse ist auskommentiert). Ein Umbau auf Ausgabe in das sheet ist kein Problem
- Die russische Seite könnte auf die gleiche Weise auch ausgegeben werden, wenn der PC auf diese Schrift umgestellt würde. Das nun mache ich aber nie und niemals.
Ich denke, dass nun meine Arbeit beendet ist: Das ganze nimmt die Form einer endlosen Spielerei die für mich von nun an keinen sichtbaren Nutzen mehr hat.

Code:

'Sub SearchAndClickLink()
'''http://www.herber.de/forum/archiv/1044to1048/1044769_Inhalt_aus_URLWebseiten_auslesen.html#1044769
Sub aaaa()
 Dim AnkerCount As Integer
 Dim index As Integer
 Dim Linkname As String, strID As String
 Dim appIE As Object
 Dim i As Integer
 Set appIE = CreateObject("InternetExplorer.application")
 appIE.Navigate2 "http://www.clever-excel-forum.de"
'"https://www.jw.org/ru/%D0%BF%D1%83%D0%B1%D0%BB%D0%B8%D0%BA%D0%B0%D1%86%D0%B8%D0%B8/%D1%81%D0%B2%D0%B8%D0%B4%D0%B5%D1%82%D0%B5%D0%BB%D0%B5%D0%B9-%D0%B8%D0%B5%D0%B3%D0%BE%D0%B2%D1%8B-%D0%B2%D1%81%D1%82%D1%80%D0%B5%D1%87%D0%B0-%D1%80%D0%B0%D0%B1%D0%BE%D1%87%D0%B0%D1%8F-%D1%82%D0%B5%D1%82%D1%80%D0%B0%D0%B4%D1%8C/%D0%BD%D0%BE%D1%8F%D0%B1%D1%80%D1%8C-2017-mwb/%D1%80%D0%B0%D1%81%D0%BF%D0%B8%D1%81%D0%B0%D0%BD%D0%B8%D0%B5-%D0%B2%D1%81%D1%82%D1%80%D0%B5%D1%87%D0%B8-6-12%D0%BD%D0%BE%D1%8F%D0%B1/"
'"http://www.ksm-soccer.eu/verein.php?id=2730"
 appIE.Visible = True
 While Not appIE.ReadyState = 4
   DoEvents
 Wend
 Application.Wait Now + TimeSerial(0, 0, 2)
 AnkerCount = appIE.Document.all.tags("a").Length
 For index = 0 To AnkerCount - 1
   'If appIE.Document.all.tags("a")(index).innertext = "Kader" Then
     appIE.Document.all.tags("a")(index).Click
     Application.Wait Now + TimeSerial(0, 0, 3)
     'Seiteninhalt im Direktfenster anzeigen
     Debug.Print appIE.Document.body.innertext
     For i = 0 To appIE.Document.Links.Length - 1
       'If InStr(1, appIE.Document.Links(i), "javascript: dverein_openSpieler", vbTextCompare) <> 0 Then
         strID = Replace(appIE.Document.Links(i), "javascript: dverein_openSpieler(", "")
         strID = Replace(strID, ")", "")
         'Spielernamen und IDs im Direktfenster anzeigen
         Debug.Print appIE.Document.Links(i).innertext & vbTab & strID
       'End If
     Next
     Exit For
   'End If
 Next
 appIE.Quit
End Sub

[DeLaGhetto]

Ich teste mal heute Abend zuhause und gebe Feedback.

Danke auf jeden Fall für deine Harte Arbeit!

[DeLaGhetto]

Funktioniert, danke