kopieëren naar usb-stick

[formatfrits]

Geachte Excel-experts,

Ik heb een probleempje waar ik niet aan uitkom.
Op mijn werk heb ik een aantal excel-bestanden staan, die behalve rekenen, ook een aantal andere taken op zich nemen. Nu is het zo dat er op onze centrale (netwerk)harddisk een PDF-bestand staat, dit kan ik door middel van een VBA-scriptje kopieëren naar een nieuwe lege USB-stick (was altijd F: ). Het excelbestand draait overigens ook vanaf het netwerk. Maar nu wil het geval dat er nieuwe computers geplaatst zijn en er ook wat laptops in gebruik zijn die een andere schijfletter voor de USB-stick gebruiken. Is er een mogelijkheid om Excel de lege USB-stick te laten herkennen en het PDF-bestandje er naartoe laten kopieëren ?
Bijgevoegd scriptje

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

    SourceDir = "M:\OM LM\MTH"
    TargetDir = "F:"
    CopyFile SourceDir, TargetDir, P
    MsgBox "aantal bestanden gekopieerd naar USB-Stick = " & 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

Alvast bedankt voor het meedenken.

 

[edmoor]

Kijk hier maar eens:
http://www.vbaexpress.com/forum/sho...ve-letters-for-Devices-with-Removable-Storage

 

[formatfrits]

Hallo Edmoor,

Ik heb er nog eens naar gekeken, zoals ik dit al eerder heb geprobeerd. Het is dus de bedoeling dat het scriptje de usb-stick vindt en vervolgens de PDF er naartoe kopieert. Deze scriptjes geven alleen de gegevens over de in het script aangegeven driveletter. Mijn vraag is, hoe kan mijn scriptje uitmaken of het D, E,of F moet worden.

Vriendelijke groet,
Frits

 

[edmoor]

Door simpel te testen of het kopiëren naar 1 van die letters goed gaat. Werkt de ene niet dan probeer je een andere.
Het script ShowDriveInfo geeft aan welke gereed drives gereed zijn voor gebruik.

 

[formatfrits]

Hallo Edmoor,

Het is gelukt door jouw aanwijzing, aangezien ik niet heel goed ben in VBA , heb ik dit stukje een aantal keren doorgekopieërd.

SourceDir = "M:\OM LM\MTH"
            TargetDir = "C:"
            CopyFile SourceDir, TargetDir, P
            MsgBox "aantal bestanden gekopieerd naar USB-Stick = " & Str$(P)

met een aantal mogelijke schijfletters. Het verdient waarschijnlijk niet de schoonheidsprijs, maar het lijkt te werken.
Misschien dat iemand de code wat kan verfraaien, maar het werkt, al moeten de collega's misschien een paar keer meer op OK klikken.

Bedankt,
Frits

 

[edmoor]

Deze laat de beschikbare verwijderbare drives zien:

Sub ShowDriveLetter()
    Dim Drive As Object, MyDrives As String

    For Each Drive In CreateObject("Scripting.FileSystemObject").Drives
        If Drive.DriveType = 1 And Drive.isready Then
            MyDrives = Drive & vbNewLine & MyDrives
        End If
    Next
    MsgBox MyDrives
End Sub

De code die je laat zien in #5 kopiëert van de M: schijf naar de C: schijf.

 

[formatfrits]

Scherp, idd de C: drive. Dat werkt dus niet. Ging hier om een voorbeeld, ik kan de D, E , F gebruiken op de computers die aan het netwerk hangen. Bij de Laptops maakt het wel wel weer uit of deze connecten met het netwerk ivm 4 USB-poorten en aangesloten randapparatuur.
Ik ga de vraag als opgelost zetten. Ik ben aardig wat verder op weg geholpen.

Bedankt,
Frits