Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

PDF Datei auswählen, kopieren und Hyperlink erstel


Betrifft: PDF Datei auswählen, kopieren und Hyperlink erstel von: Josi
Geschrieben am: 15.01.2018 11:11:02

Hallo,

ich möchte mittels VBA eine PDF Datei in einem Laufwerk auswählen (Kann immer ein anderes Laufwerk sein, Starten will ich mit M:\Austauschverzeichnis) diese Kopieren (evtl. Zwischenablage?!) und dann in einem Vordefinierten Ordner("W:\Dokumente\Format\20_Störungen\40_Digitale Liste offener Punkte dLOP\10_Blistermaschine\" & Range("D5").Value & "-" & Range("F18").Value) Speichern. Eine Umbenennung der Datei ist nicht nötig, wäre aber schön. Dann soll im der Excel Zelle der Hyperlink zu dem neuen Dateipfad erstellt werden.

Ich wäre wirklich seeeehr dankbar wenn mir jemand eine Lösung hat.

Liebe Grüße Josi

  

Betrifft: AW: PDF Datei auswählen, kopieren und Hyperlink erstel von: UweD
Geschrieben am: 15.01.2018 12:19:32


Hallo


so??

Sub PDF_umbenennen()
    Dim TB, StartPfad As String, ZielPfad As String, Datei As String, ZielDatei As String
    Dim Pfad2 As String, Ext As String, RNG As Range
    Dim Dlg As FileDialog, Fso As Object

    Set TB = ThisWorkbook.Sheets("Tabelle1")
    StartPfad = "M:\Austauschverzeichnis\"
    ZielPfad = "W:\Dokumente\Format\20_Störungen\40_Digitale Liste offener Punkte dLOP\10_Blistermaschine\"
    Pfad2 = TB.Range("D5").Value & "-" & TB.Range("F18") & "\"
    Ext = "*.pdf"
    
    Set RNG = TB.Range("A1") 'Zielzelle 

    
    
    Set Dlg = Application.FileDialog(msoFileDialogFilePicker) 'Datei wählen 
    With Dlg
        .AllowMultiSelect = False
        .InitialFileName = StartPfad & Ext
        .InitialView = msoFileDialogViewDetails 'Anzeige des Dialogs - die Dateien als Detail 
        .Title = "Datei auswählen"
    End With
    If Dlg.Show = True Then
        Datei = Dlg.SelectedItems(1)
        ZielDatei = ZielPfad & Pfad2 & Dir(Datei)
        'Kopieren 
        Set Fso = CreateObject("Scripting.FileSystemObject")
        Fso.copyfile Datei, ZielDatei
    
        'Link setzen 
        RNG.Hyperlinks.Delete 'erst löschen 
        
        RNG.Hyperlinks.Add Anchor:=Selection, _
            Address:=ZielDatei, TextToDisplay:=Dir(Datei)
        
    
    End If

End Sub

LG UweD


  

Betrifft: AW: Hat funktioniert!!! von: Josi
Geschrieben am: 15.01.2018 12:59:29

Hallo Uwe,

Vielen Dank klappt super, du hast mir auch schon mal bei einem anderen Problem geholfen auch dafür vielen Dank.

Liebe Grüße Josi


  

Betrifft: Prima! Danke für die Rückmeldung. owT von: UweD
Geschrieben am: 15.01.2018 13:06:14




  

Betrifft: AW: Prima! Danke für die Rückmeldung. owT von: Josi
Geschrieben am: 15.01.2018 13:32:17

Hallo Uwe,

wenn du sowieso gerade online bist:

Das mit dem einfügen der PDF hat ja super geklappt (habe davor noch den Ordner erstellt), im _ zweiten

Sub möchte ich gerne genau diese eigefügte Datei wieder Löschen, wie kann ich von dem einen  _
Makro den Dateinamen (ZielDatei) in das Folgemakro übergeben?


Sub Blisterzeichnungeinfügen()
    Dim TB, StartPfad As String, ZielPfad As String, Datei As String, ZielDatei As String
    Dim Pfad2 As String, Ext As String, RNG As Range
    Dim Dlg As FileDialog, Fso As Object

    Dim Speicherordner As String

    Speicherordner = "W:\Dokumente\Format\20_Störungen\40_Digitale Liste offener Punkte dLOP\ _
10_Blistermaschine\" & Range("D5").Value & "-" & Range("F18").Value
    
    'Ordner erstellen
If Dir(Speicherordner, vbDirectory) = "" Then
  MkDir (Speicherordner)
  MsgBox "Ordner wurde angelegt!"
Else
  MsgBox "Ordner ist vorhanden!"
End If

    
    Set TB = ThisWorkbook.Sheets("SFB_BM")
    StartPfad = "M:\Austauschverzeichnis\"
    ZielPfad = "W:\Dokumente\Format\20_Störungen\40_Digitale Liste offener Punkte dLOP\ _
10_Blistermaschine\"
    Pfad2 = TB.Range("D5").Value & "-" & TB.Range("F18") & "\"
    Ext = "*.pdf"
    
    Set RNG = TB.Range("B11") 'Zielzelle

    
    
    Set Dlg = Application.FileDialog(msoFileDialogFilePicker) 'Datei wählen
    With Dlg
        .AllowMultiSelect = False
        .InitialFileName = StartPfad & Ext
        .InitialView = msoFileDialogViewDetails 'Anzeige des Dialogs - die Dateien als Detail
        .Title = "Datei auswählen"
    End With
    If Dlg.Show = True Then
        Datei = Dlg.SelectedItems(1)
        ZielDatei = ZielPfad & Pfad2 & Dir(Datei)
        'Kopieren
        Set Fso = CreateObject("Scripting.FileSystemObject")
        Fso.copyfile Datei, ZielDatei

    
' Hyperlink Makro
    Range("B11").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        ZielDatei _
        , TextToDisplay:="Blisterzeichnung"
            End If

' BildEinfügenindirekteUrsacheausblenden BildändernIndirekteUrsacheeinblenden Makro

   ActiveSheet.Shapes.Range(Array("Blisterzeichnung einfügen")).Visible = False
    ActiveSheet.Shapes.Range(Array("Blisterzeichnung ändern")).Visible = True

End Sub

Sub Blisterzeichnungändern()


On Error Resume Next
Kill (ZielDatei)

Call Blisterzeichnungeinfügen

End Sub



  

Betrifft: AW: Prima! Danke für die Rückmeldung. owT von: UweD
Geschrieben am: 15.01.2018 14:02:27

Hallo

am Anfang des Moduls wird die Variable Public deklariert.
Dann ist Sie für alle Makros verwendbar




- Du hast die Pfade mehrfach vergeben. hab ich angepasst
- select kann in 99% der Fälle wegfallen


Public ZielDatei As String
Option Explicit

Sub Blisterzeichnungeinfügen()
    Dim TB, StartPfad As String, Speicherordner As String, Datei As String
    Dim Ext As String, RNG As Range
    Dim Dlg As FileDialog, Fso As Object


    Set TB = ThisWorkbook.Sheets("SFB_BM")
    StartPfad = "M:\Austauschverzeichnis\"
    Speicherordner = "W:\Dokumente\Format\20_Störungen\40_Digitale Liste offener Punkte dLOP\10_Blistermaschine\" & Range("D5").Value & "-" & Range("F18") & "\"
    Ext = "*.pdf"
    
    'Ordner erstellen 
    If Dir(Speicherordner, vbDirectory) = "" Then
        MkDir (Speicherordner)
        MsgBox "Ordner wurde angelegt!"
    Else
        MsgBox "Ordner ist vorhanden!"
    End If

    
    Set RNG = TB.Range("B11") 'Zielzelle 
    
    Set Dlg = Application.FileDialog(msoFileDialogFilePicker) 'Datei wählen 
    With Dlg
        .AllowMultiSelect = False
        .InitialFileName = StartPfad & Ext
        .InitialView = msoFileDialogViewDetails 'Anzeige des Dialogs - die Dateien als Detail 
        .Title = "Datei auswählen"
    End With
    If Dlg.Show = True Then
        Datei = Dlg.SelectedItems(1)
        ZielDatei = Speicherordner & Dir(Datei)
        'Kopieren 
        Set Fso = CreateObject("Scripting.FileSystemObject")
        Fso.copyfile Datei, ZielDatei

    
        ' Hyperlink Makro 
        TB.Hyperlinks.Add Anchor:=RNG, Address:=ZielDatei _
            , TextToDisplay:="Blisterzeichnung"
    End If

    ' BildEinfügenindirekteUrsacheausblenden BildändernIndirekteUrsacheeinblenden Makro 

   TB.Shapes.Range(Array("Blisterzeichnung einfügen")).Visible = False
   TB.Shapes.Range(Array("Blisterzeichnung ändern")).Visible = True

End Sub



Sub Blisterzeichnungändern()


    On Error Resume Next
    Kill (ZielDatei)

    Call Blisterzeichnungeinfügen

End Sub

LG UweD


  

Betrifft: AW: Nochmals Danke! von: Josi
Geschrieben am: 15.01.2018 14:44:14

Hallo Uwe,

nochmals Vielen Dank es klappt super!

Liebe Grüße Josi


Beiträge aus dem Excel-Forum zum Thema "PDF Datei auswählen, kopieren und Hyperlink erstel"