Check if USB drive of path is present

[gemini528]

Hi Excel guru’s:

I need a revision on the Macro below. I need to check if drive or path is present so that it will not create an error. Maybe a message like “ Please insert a USB in the drive” something like that. It creates an error if the USB drive is not inserted on the slot.

Thank you very much.

[Option Explicit
Sub Update()

  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  Dim wbCopyTo As Workbook
  Dim wsCopyTo As Worksheet

  Dim wbCopyFrom As Workbook
  Dim wsCopyFrom As Worksheet

  Set wbCopyTo = ActiveWorkbook
  Set wsCopyTo = Sheets("Locator")

        Set wbCopyFrom = Workbooks.Open("F:\Removable Disk (F) 2016\Report.xlsb", Password:="**")
        Set wsCopyFrom = wbCopyFrom.Worksheets("Locator")

     wsCopyTo.Range("C4:K8").ClearContents
     wsCopyFrom.Range("C4:K8").Copy
     wsCopyTo.Range("C4").PasteSpecial Paste:=xlPasteValues, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
     wbCopyFrom.Close SaveChanges:=False

  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
    Beep
     MsgBox "The Data is now Updated, click OK to PROCEED...", vbInformation + vbOKOnly, "     "
End Sub
/CODE]

 

[Rosen]

Here is some code that should do what you're looking to do. It is mostly just derived from the sample code found here https://support.microsoft.com/en-us/kb/180766

Option Explicit


Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
      "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
      ByVal lpBuffer As String) As Long


Private Function FindProperDrive(ByVal FilePath As String) As String
    Dim strDrives As String, strDrive As String
    Dim msg As String, lStart As Long: lStart = 1
    strDrives = Space(150)
    GetLogicalDriveStrings 150, strDrives
    strDrive = Mid(strDrives, lStart, 3)
    Do
        If Not VBA.FileSystem.Dir(strDrive & FilePath) = vbNullString Then
            FindProperDrive = strDrive & FilePath
            Exit Function
        End If
        lStart = lStart + 4
        strDrive = Mid(strDrives, lStart, 3)
    Loop While (Mid(strDrives, lStart, 1) <> vbNullChar)
End Function


Sub Update()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False


    Dim wbCopyTo As Workbook
    Dim wsCopyTo As Worksheet


    Dim wbCopyFrom As Workbook
    Dim wsCopyFrom As Worksheet
    
Update_FindReport:
    Dim Report As String: Report = FindProperDrive("Removable Disk (F) 2016\Report.xlsb")
    If Report = vbNullString Then
        If MsgBox("Please insert a USB in the drive and click OK", vbExclamation + vbOKCancel, "Report File Not Found!") = vbCancel Then
            Application.EnableEvents = True
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
            Exit Sub
        End If
        GoTo Update_FindReport
    End If


    Set wbCopyTo = ActiveWorkbook
    Set wsCopyTo = Sheets("Locator")
    
    Set wbCopyFrom = Workbooks.Open(Report, Password:="**")
    Set wsCopyFrom = wbCopyFrom.Worksheets("Locator")


    wsCopyTo.Range("C4:K8").ClearContents
    wsCopyFrom.Range("C4:K8").Copy
    wsCopyTo.Range("C4").PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False


    wbCopyFrom.Close SaveChanges:=False


    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Beep
    MsgBox "The Data is now Updated, click OK to PROCEED...", vbInformation + vbOKOnly, " "
 End Sub

 

[gemini528]

Thank you very much and will test it tomorrow.

 

[gemini528]

I tested the code and I get a “Runtime error 52, bad filename or number” on line “If Not VBA.FileSystem.Dir(strDrive & FilePath) = vbNullString Then…” I would appreciate it if you can correct the error.

Thank you very much.

 

[shg]

Sub Update()
  Dim wbCopyTo      As Workbook
  Dim wsCopyTo      As Worksheet

  Dim wbCopyFrom    As Workbook
  Dim wsCopyFrom    As Worksheet

  If Len(Dir("F:\", vbDirectory)) = 0 Then
    MsgBox "Insert drive and try again!"
    Exit Sub
  End If

  If Len(Dir("F:\Removable Disk (F) 2016\Report.xlsb")) = 0 Then
    MsgBox "No file!"
    Exit Sub
  End If
  
  ' carry on ...

 

[gemini528]

Thank you, its working for me.

 

[shg]

You're welcome.

 

[jimrward]

you could with a little more coding use filesystemobject and check the drivetype and driveletter, drivetype=1 is removable, =2 fixed, =3 network

 

[gemini528]

Thank you for your input. I am a newbie so can you incorporate it in the Macro for me to test it?