HTML-Seiten den Favoriten hinzufügen

Home Zurück Vor

Download der Beispiel-Arbeitsmappe

Gruppe

Extern

Bereich

Internet

Thema

HTML-Seiten den Favoriten hinzufügen

Problem

Den Favoriten soll ein neuer Ordner mit Internetadressen hinzugefügt werden.

Lösung

Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.




StandardModule: basMain

Sub SetFavorites()
   Dim rng As Range
   Dim sPath As String
   sPath = WindowsFolder & "\Favoriten"
   On Error Resume Next
   MkDir sPath
   sPath = sPath & "\" & ActiveSheet.Name
   MkDir sPath
   On Error GoTo 0
   Close
   For Each rng In Range("A1").CurrentRegion.Cells
      If rng.Hyperlinks.Count > 0 Then
         Open sPath & "\" & rng.Value & ".URL" For Output As #1
         Print #1, CreateLink(rng.Hyperlinks(1).Address)
         Close
      End If
   Next rng
   MsgBox "Die Favoriten wurden angelegt!"
End Sub

Private Function CreateLink(sLink As String)
   Dim sTxt As String
   sTxt = "[Default]" & vbLf
   sTxt = sTxt & "BASEURL=" & sLink & vbLf & vbLf
   sTxt = sTxt & "[InternetShortcut]" & vbLf
   sTxt = sTxt & "URL=" & sLink & vbLf
   CreateLink = sTxt
End Function

StandardModule: basFunctions

Declare Function GetWindowsDirectory Lib "kernel32.dll" _
   Alias "GetWindowsDirectoryA" ( _
   ByVal lpBuffer As String, ByVal nSize As Long) As Long

Function WindowsFolder()
   Dim lLength As Long
   Dim sWinDir As String
   sWinDir = Space(255)
   lLength = GetWindowsDirectory(sWinDir, 255)
   WindowsFolder = Left(sWinDir, lLength)
End Function