Anlegen von Verknüpfungen per Script

'  
Dim xl_Datei, xl_Cells, MyLnk, MyBase, UrlFile, txf
xl_Datei = "C:\Test\Favoriten.xls"  
xl_Cells = "[Tabelle1$A2:C3]"  
MyBase = "C:\Test\"  

Dim oWSH :Set oWSH  = WScript.CreateObject("WScript.Shell")  
Dim oFSys:Set oFSys = CreateObject("Scripting.FileSystemObject")  
Dim oConn:Set oConn = CreateObject("ADODB.Connection")  
Dim oRecS:Set oRecS = CreateObject("ADODB.Recordset")  

oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0" & _  
  ";Data Source=" & xl_Datei & _  
  ";Extended Properties=""Excel 8.0;HDR=No;"";"  
oRecS.Open "Select * from " & xl_Cells, oConn, 3, 3, 1  

' Spalte A Field 0 = Gruppe  
' Spalte B Field 1 = Ziel  
' Spalte C Field 2 = Klartextname  

Do Until oRecS.EOF
  CreateUrl oRecS.Fields(0).Value, oRecS.Fields(1).Value, oRecS.Fields(2).Value
' CreateLnk oRecS.Fields(0).Value, oRecS.Fields(1).Value, oRecS.Fields(2).Value  
  oRecS.MoveNext
Loop

oRecS.Close
oConn.Close

Sub CreateUrl(Gruppe, Ziel, Klartextname)
  wscript.echo "URL:" & Gruppe & vbTab & Ziel & vbTab & Klartextname  
  Set txf = oFSys.CreateTextFile(MyBase & Gruppe & "\" & Klartextname & ".url", True)  
  txf.WriteLine "[DEFAULT]"  
  txf.WriteLine "BASEURL=" & Ziel  
  txf.WriteLine "[InternetShortcut]"   
  txf.WriteLine "URL=" & Ziel  
' txf.WriteLine "IconFile="  
' txf.WriteLine "IconIndex=1"  
  txf.close
End Sub

Sub CreateLnk(Gruppe, Ziel, Klartextname)
  wscript.echo "LNK:" & Gruppe & vbTab & Ziel & vbTab & Klartextname  
  Set MyLnk = oWSH.CreateShortcut( _
    MyBase & Gruppe &" \" & Klartextname & ".lnk")  
  with MyLnk 
    .TargetPath = Ziel
    .Description = KlartextName
'   .WindowStyle = 4  
'   .Hotkey =   
'   .IconLocation =  
'   .WorkingDirectory =  
'   .Arguments =  
    .Save
  End with
  Set MyLnk = Nothing
End Sub