|
Hallo zusammen,
ich habe dieses Makro geschrieben. Es bewirkt, dass der Hyperlink gesucht wird und in Spalte 10 (J) geschrieben wird.
---------------------------------------------------
Public Sub setHyperlinkToPDF_xlph() ' sucht im Ordner und fügt Hyperlink ein ***
Dim strFolderPath As String
Dim strFile As String
Dim strPdfFile As String
Dim strPdfFilePath As String
Dim colPdfFiles As Collection
Dim strArtNr As String
Dim lngRow As Long
Dim FSO As Object
strFolderPath = "O:\" ' Anpassen *****
Set colPdfFiles = New Collection
' Alle PDF-Dateinamen einlesen ***
Set FSO = CreateObject("Scripting.FileSystemObject")
Call GetSubFolders_Files(FSO, colPdfFiles, strFolderPath)
Set FSO = Nothing
' ArtikelNrn durchlaufen und Hyperlinks setzen, hier mit Angabe des Pfades ***
With ActiveSheet
For lngRow = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
strArtNr = CStr(.Cells(lngRow, 1).Value)
If Len(strArtNr) > 0 Then
strPdfFilePath = getPdfFile(colPdfFiles, strArtNr)
If Len(strPdfFilePath) > 0 Then
.Hyperlinks.Add .Cells(lngRow, 10), strPdfFilePath, , strArtNr, strPdfFilePath ' Hier ist der Pfad ***
.Cells(lngRow, 10).Font.Size = 9 ' Hier ist der Pfad ***
End If
End If
Next
End With
Set colPdfFiles = Nothing
End Sub
Public Function getPdfFile(ByRef col As Collection, ByVal strArtNr As String) As String
Dim varItem As Variant
strArtNr = LCase$(strArtNr)
For Each varItem In col
If LCase$(varItem(0)) Like strArtNr & "*.pdf" Then
getPdfFile = varItem(1) & "\" & varItem(0): Exit For
End If
Next
End Function
Public Sub GetSubFolders_Files(FSO, colFiles As Collection, strPath As String)
Dim FO As Object, FU As Object, F As Object, Fi As Object
Set FO = FSO.GetFolder(strPath)
Set FU = FO.SubFolders
On Error Resume Next
For Each Fi In FO.Files
If LCase$(Fi.Name) Like "*.pdf" Then
' Debug.Print Fi.Name, strPath
colFiles.Add Array(Fi.Name, strPath)
End If
Next
For Each F In FU
Call GetSubFolders_Files(FSO, colFiles, F.Path)
Next
End Sub
----------------------------------------------------------------------
Meine Ordner in dem Laufwerk O:\ sind wie folgt beschriftet:
Hauptordner: Kd.-Nr.(Spalte B) LEERZEICHEN Kunde
Unterordner: M+H Art.Nr.(Spalte A)
Datei: M+H Art.Nr.(Spalte A) LEERZEICHEN Bilder LEERZEICHEN blablabla
Ich möchte jetzt aber folgendes, weil mein Code zu fehlerhaft ist:
1. Der Code muss so geändert werden, dass erst der richtige Hauptordner (gemäß Spalte B) gefunden wird und dann der richtige Unterordner (gemäß Spalte A) gefunden wird und dann das richtige PDF (gemäß Spalte A zzgl. dem Wort Bilder). Es gibt nämlich mehrere Kunden die dieselbe Artikelnummer bekommen.
2. Darüber hinaus brauche ich in einem weiteren Modul die Möglichkeit, dass nach PDF, WORD und HLW gesucht wird.
Danke für eure Hilfe.
Ich kann auch eine Musterdatei per Mail senden.
|