Hallo Plextor,
hier habe ich mal eine Lösung, die funktioniert.
Sollte jemand was besseres wissen, bin ich interessiert!
Kurze Bedienungsanleitung:
Lege eine Verknüpfung für das gewünschte Programm an.
Den Namen gibst Du dann bei „Const Dateiname“ an. Als Beispiel ist die Notepad-Verknüpfung eingetragen. Den Pfad, wo die Verknüpfung liegt, trägst Du entsprechend bei „Pfad“ ein.
Den Zielpfad solltest Du zum Testen gleich dem Pfad setzen ("= Pfad").
Ja und dann CreateCopyFileArray ausführen, Code in die leere Funktion kopieren und dann WriteNewFile ausführen.
Viel Spaß! 
Kristian
Option Explicit
Option Base 1
'Kristian Zarse am 10.04.2001
Dim FileCopy() As Byte
Dim AnzahlBytes As Long
Const Dateiname As String = "Notepad.lnk"
Const Pfad As String = "C:\Temp\"
Const ZielPfad As String = "C:\WINDOWS\All Users\Start Menu\Programs\StartUp" 'Zum Beispiel. Wird bei Dir anders sein.
Private Function FillFileCopy() As Long
'Hier muß der ausgegebene Code rein.
End Function 'FillFileCopy()
Private Function LoadFileBytes(FileNameIn As String) As Long
Dim F As Integer
Dim i As Long
F = FreeFile
ReDim FileCopy(1) 'löschen
Open FileNameIn For Binary Access Read As #F
i = 0
Do While Not EOF(F)
i = i + 1
ReDim Preserve FileCopy(i)
Get #F, , FileCopy(i)
Loop
Close #F
LoadFileBytes = i
End Function 'LoadFileBytes
Private Sub SaveFileBytes(FileNameOut As String, n As Long)
Dim F As Integer
Dim i As Long
F = FreeFile
Open FileNameOut For Binary Access Write As #F
For i = 1 To n
Put #F, , FileCopy(i)
Next i
Close #F
End Sub 'SaveFileBytes
Private Sub WriteByteArrayFillingCode(FileNameSub As String, n As Long)
Dim F As Integer
Dim i As Long
F = FreeFile
Open FileNameSub For Output As #F
Print #F, "Private Function FillFileCopy() As Long"
Print #F, ""
Print #F, " ReDim FileCopy(" & n & ")"
For i = 1 To n
Print #F, " FileCopy(" & i & ") = " & FileCopy(i)
Next i
Print #F, " FillFileCopy = " & n
Print #F, ""
Print #F, "End Function 'FillFileCopy()"
Print #F, ""
Close #F
MsgBox "Nun den ausgegebenen Code in die Funktion ganz oben kopieren!" & \_
vbLf & vbLf & \_
"(" & n & " Bytes = " & n & " Zeilen)", vbExclamation
End Sub 'WriteByteArrayFillingCode
'##########################################################################################
'Diese Sub zuerst ausführen ...
Sub CreateCopyFileArray()
AnzahlBytes = LoadFileBytes(Pfad & Dateiname)
Call WriteByteArrayFillingCode(Pfad & Dateiname & ".sub", AnzahlBytes)
End Sub 'CreateCopyFileData
'... dann diese.
Sub WriteNewFile()
AnzahlBytes = FillFileCopy
Call SaveFileBytes(ZielPfad & \_"Neu\_" & Dateiname, AnzahlBytes)
MsgBox "Fertig.", vbInformation
End Sub 'WriteNewFile
