Dateiverknüpfungen in VBA erstellen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
Das ist mal für einen Standardordner ohne Unterverzeichnisse zu berücksichtigen, da du keinen Hinweis darauf gibst, wie die Zielstruktur aussehen soll
Option Explicit

Sub Create_Shortcut_in_specific_Target_Folder()
    'by Ramses
    Dim myFSO As Object
    Dim myFSOShell As Object
    Dim mySourceFolder As String, myTargetFolder As String
    Dim myFSOFolder As Object, myFSOFiles As Object, tmpName As String
    Dim myShortCut As Object
    Dim mySourceFile As Object, myFileExt As String
    'Variablen füllen
    mySourceFolder = "C:\Ordner1"
    myTargetFolder = "C:\Ordner2"
    myFileExt = ".xls"
    '*************************
    'Ab hier nichts mehr ändern
    Set myFSO = CreateObject("Scripting.FileSystemObject")
    Set myFSOShell = CreateObject("WScript.Shell")
    'Verzeichnis und Unterverzeichnis anlegen
    ChDrive "C:"
    If Not myFSO.folderexists(myTargetFolder) Then
        On Error Resume Next
        MkDir myTargetFolder
    End If
    Set myFSOFolder = myFSO.getfolder(mySourceFolder)
    For Each mySourceFile In myFSOFolder.Files
        Debug.Print Right(mySourceFile, 4)
        If Right(mySourceFile, 4) = myFileExt Then
            tmpName = Left(mySourceFile, Len(mySourceFile) - 4)
            tmpName = Right(tmpName, Len(tmpName) - InStrRev(tmpName, "\", -1))
            Set myShortCut = myFSOShell.CreateShortcut(myTargetFolder & "\" & "LINK_" & tmpName & ".lnk")
            With myShortCut
                'Fenstertyp beim öffnen
                ' 4=Normal 3=Maximized 7=Minimized
                .windowstyle = 4
                .iconlocation = mySourceFile
                ' o der alternativ ein anderes Icon
                '.IconLocation = "C:\graph9.ico"
                .Targetpath = Left(mySourceFile, Len(mySourceFile) - 4) & myFileExt
                'Speichern
                .Save
            End With
        End If
    Next
End Sub

Gruss Rainer

Hallo
... aber bitte sehr:
Option Explicit

Sub Create_Shortcut_in_specific_Target_Folder()
    'by Ramses
    Dim myFSO As Object
    Dim myFSOShell As Object
    Dim mySourceFolder As String, myTargetFolder As String
    Dim myFSOFolder As Object, myFSOFiles As Object, tmpName As String
    Dim myShortCut As Object
    Dim mySourceFile As Object, myFileExt As String
    'Variablen füllen
    mySourceFolder = "C:\Ordner1"
    myTargetFolder = "C:\Ordner2"
    '*************************
    'Ab hier nichts mehr ändern
    Set myFSO = CreateObject("Scripting.FileSystemObject")
    Set myFSOShell = CreateObject("WScript.Shell")
    'Verzeichnis und Unterverzeichnis anlegen
    ChDrive "C:"
    If Not myFSO.folderexists(myTargetFolder) Then
        On Error Resume Next
        MkDir myTargetFolder
    End If
    Set myFSOFolder = myFSO.getfolder(mySourceFolder)
    For Each mySourceFile In myFSOFolder.Files
        tmpName = mySourceFile
        tmpName = Right(tmpName, Len(tmpName) - InStrRev(tmpName, "\", -1))
        Set myShortCut = myFSOShell.CreateShortcut(myTargetFolder & "\" & "LINK_" & tmpName & ".lnk")
        With myShortCut
            'Fenstertyp beim öffnen
            ' 4=Normal 3=Maximized 7=Minimized
            .windowstyle = 4
            .iconlocation = mySourceFile
            ' o der alternativ ein anderes Icon
            '.IconLocation = "C:\graph9.ico"
            .Targetpath = mySourceFile
            'Speichern
            .Save
        End With
    Next
End Sub

Gruss Rainer

Beliebteste Forumthreads (12 Monate)

Dateiverknüpfungen in VBA erstellen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

46 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Dateiverknüpfungen in VBA erstellen

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

46 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread