Bestand kopieëren vanuit excel

[formatfrits]

Beste experts,
ik werk met een uitgebreide excelwerkmap met daarin veel berekeningen, maar ook gegevens.
Nu wil ik vanuit Excel met een macro , een PDF-bestand vanuit een vaste map (M:LM/MTH/mth.pdf) kopieëren naar een usb-stick. Nu komt het feit dat dat dit"programma" op meerdere PC's en laptop gebruikt wordt. Maar natuurlijk is niet op iedere PC aan de USB-stick dezelfde driveletter toegewezen. Het lukt mij dus op een PC waar de driveletter eigenlijk altijd "F:" is wel, vast opgenomen in de macro. Maar op het moment dat ik dit op de laptop doe ( USB-stick = D werkt dat dus niet meer. Is er nu iemand die een macro heeft of kan maken die ofwel zelf de juiste drive kiest ofwel een keuzemenuutje voorschoteld net als bijvoorbeeld voor het printen op netwerkprinters.
En ja, ik heb te maken met veel drives (netwerk) per PC/laptop.

alvast bij voorbaat dank,
Frits

 

[Warme bakkertje]

Sub tst()
 For Each dr In CreateObject("Scripting.FileSystemObject").drives
    If dr.DriveType = 1 And dr.driveletter <> "A"  Then
        MsgBox dr.DriveType & vbLf & dr.driveletter & vbLf & dr.FileSystem
    End If
Next
End Sub

 

[formatfrits]

Mooie korte code, maar heb je hier wat meer info bij. Als ik deze code run krijg ik een foutmelding.
Moet ik nog iets toevoegen ?
ik heb tot nog toe het volgende gebruikt :

Private Sub CommandButton1_Click()
 Dim SourceDir As String
    Dim TargetDir As String
    Dim X As Integer
    Dim P As Integer

    SourceDir = "L:\OM CDS\CDS Hulp\MTH"
    TargetDir = "D:"
    CopyFile SourceDir, TargetDir, P
    MsgBox "Number of files copied = " & Str$(P)

End Sub
Sub CopyFile(SrcDir As String, TrgtDir As String, NumFiles As Integer)
    Dim OldDir As String  'source dir name
    Dim NewDir As String 'target dir name
    Dim FileName As String 'source filename
    Dim sType As String 'file type (extension)

    OldDir = SrcDir
    If Right$(OldDir, 1) <> "\" Then
        OldDir = OldDir & "\"
    End If

    NewDir = TrgtDir
    If Right$(NewDir, 1) <> "\" Then
        NewDir = NewDir & "\"
    End If

    NumFiles = 0      'returns # files copied

    FileName = Dir$(OldDir & "*.*")
    While FileName <> ""
        On Error Resume Next
            FileCopy (OldDir & FileName), (NewDir & FileName)
            If Err = 0 Then
                NumFiles = NumFiles + 1
            Else
                Beep
                MsgBox Error$, MB_ICONEXCLAMATION, ("Error copying file " & FileName)
            End If
        On Error GoTo 0

        FileName = Dir$        'get next matching file

        DoEvents            'allow processes to occur
    Wend
End Sub

Hoe kan ik jou code hier in verwerken ?

Groeten,
Frits

 

[Warme bakkertje]

1.Steek een USB-stick in een poort en draai dan de code. Normaal gezien krijg je een msgbox met driveletter v/d stick.

2. Zeggen dat je een foutmelding krijgt is één maar kan je dan ook zeggen welke of op welke regel want dat kan ik van hieruit niet zien.

 

[Warme bakkertje]

Private Sub CommandButton1_Click()
    Dim SourceDir As String
    Dim TargetDir As String
    Dim X As Integer
    Dim P As Integer
    For Each dr In CreateObject("Scripting.FileSystemObject").drives
        If dr.DriveType = 1 And dr.driveletter <> "A" Then TargetDir = dr.driveletter
    Next
    SourceDir = "L:\OM CDS\CDS Hulp\MTH"
    'TargetDir = "D:"
    CopyFile SourceDir, TargetDir, P
    MsgBox "Number of files copied = " & Str$(P)
End Sub

 

[formatfrits]

Hoi,
ik krijg hier een foutmelding : MsgBox dr.DriveType & vbLf & dr.driveletter & vbLf & dr.FileSystem
En de foutmelding ziet er zo uit :

een USB-stick zowel rechtstreeks in de PC alsook via een hub, en dit tegelijk.

Groeten,
Frits

 

[Warme bakkertje]

Gebruik alleen eens diegene rechtstreeks in de pc en probeer dan nog eens, want hier werkt dit foutloos.

 

[formatfrits]

Hoi Bakkertje,

De door jou aangepaste code ook even gedraaid, wederom foutmelding :

Iets doet het dus niet in deze code, wat overigens zeer vreemd is. Ik neem aan dat je het zelf ook test .

Groeten,
Frits

 

[formatfrits]

Daar ben ik weer, moest ff weg.
De code ingevoegd op de werk-laptop, waar het gebruikt wordt. Maar helaas vind via de code wel het bestanden kopieert deze, maar kan op de een of andere manier het path naar de USB-stick niet vinden.
Ik gebruik hiervoor de normaal te gebruiken USB-stick en natuurlijk rechtstreeks in de laptop. De drive heeft op de deze laptop overigens de letter E:

Groeten,
Frits