Reconhecer a porta USB automaticamente

Boa tarde,


Galera, estou com um probleminha... Fiz uma planilha para um cliente, onde ele faz uns controles em R$ e o cadastro com imagens. As imagens e a planilha ficam no pendrive. Quando faço a procura da imagem fica assim:

Código:

Private Sub ComboBox2_Change()

Sheets("Controles").Range("L2") = ComboBox2


Dim Imagem
Dim arq


    arq = "E:\Planilha\ESPONJAS.bmp"
    Set Image1.Picture = LoadPicture(arq) ' carrega a imagem
      Image1.PictureSizeMode = fmPictureSizeModeZoom
    
    Imagem = "E:\Planilha\" & Sheets("Controles").Range("L2") & ".bmp"

      If Dir(Imagem) <> "" Then ' verifica se o arquivo existe
      Set Image1.Picture = LoadPicture(Imagem) ' carrega a imagem
      Image1.PictureSizeMode = fmPictureSizeModeZoom
      
      
End If
End Sub

O problema se encontra no caminho... Pois quando coloca o pendrive em outro pc ou outra porta ele reconhece outra unidade.


Tem como criar um método para reconhecer automaticamente a porta?


Atenciosamente.

Fernando

O Access precisa sabe em que porta USB está espetado o Pendrive.

Para isso, veja o código abaixo:

Por primeiro, faça a referência ao Microsoft Scripting Runtime

Código:



Public Function DriveUSB() As String
'Esta função retorna o drive que o pendrive está espetado

Dim fso As New Scripting.FileSystemObject
Dim mDrive As Drive

On Error Resume Next

For Each mDrive In fso.Drives
    If mDrive.DriveType = 1 And mDrive.DriveLetter <> "A" Then
      If mDrive.DriveType = 1 And mDrive.IsReady = True Then

          DriveUSB = mDrive & "\"
           
          Exit For
      End If
    End If
Next
Set fso = Nothing
End Function


Para usar:
arq = DriveUSB & = "Planilha\ESPONJAS.bmp"

Abraços

Nb

Boa noite Noobezinho, tudo bem?

Criei a função tudo certinho, fiz a referencia também. Mas esta dando um erro, ainda diz que o caminho não foi localizado...

Código:

Public Function DriveUSB() As String
'Esta função retorna o drive que o pendrive está espetado

Dim fso As New Scripting.FileSystemObject
Dim mDrive As drive

On Error Resume Next

For Each mDrive In fso.Drives
    If mDrive.DriveType = 1 And mDrive.DriveLetter <> "E" Then
       If mDrive.DriveType = 1 And mDrive.IsReady = True Then

           DriveUSB = mDrive & "\"
            
           Exit For
       End If
     End If
Next
Set fso = Nothing
End Function

Private Sub ComboBox2_Change()

Sheets("Controles").Range("L2") = ComboBox2


Dim Imagem
Dim arq


    arq = mDriveUSB & "Jogo do Bicho\ESPONJAS.bmp"
    Set Image1.Picture = LoadPicture(arq) ' carrega a imagem
      Image1.PictureSizeMode = fmPictureSizeModeZoom
    
    Imagem = DriveUSB & "Jogo do Bicho\" & Sheets("Controles").Range("L2") & ".bmp"

      If Dir(Imagem) <> "" Then ' verifica se o arquivo existe
      Set Image1.Picture = LoadPicture(Imagem) ' carrega a imagem
      Image1.PictureSizeMode = fmPictureSizeModeZoom
      
      
End If
End Sub

Fernando

Esta linha:

If mDrive.DriveType = 1 And mDrive.DriveLetter <> "E" Then

O drive tem que ser o "A" no lugar do "E" justamente para descartar esse drive, os demais drives, serão tratados
pelo código.

Sabe usar a Janela imediata do visual basic?

Abra qualquer módulo, se a janela imediata não estiver a mostra, aperte Crtl+G

copie e cole nessa janela:
? DriveUSB ' na linha embaixo deverá retornar a letra da USB onde está espetado o pendrive.

Se estiver ok , teste a debaixo.

? DriveUSB & "Jogo do Bicho\" & Sheets("Controles").Range("L2") & ".bmp"

e veja o resultado se está correto na linha de baixo.

Acredito que o problema está nessa parte:

& Sheets("Controles").Range("L2") &

Talvez tenha que colocar aspas simples no lugar das aspas duplas
ou ainda quebrar toda a linha e colocar no lugar das aspas duplas o chr(34)
assim:

Imagem = DriveUSB & "Jogo do Bicho\" &  "Sheets(" & chr(34) & "Controles" & chr(34) & ").Range(" & chr(34) & "L2" & chr(34) & ")"& ".bmp"

Teste

Nb

Boa noite, caraa consegui resolver meu problema de uma forma um pouco mais simples...

"ThisWorkbook.Path"

Código:



Private Sub ComboBox2_Change()

    Sheets("Controles").Range("L2") = ComboBox2

    Dim Imagem
    Dim arq

    arq = ThisWorkbook.Path & "\ESPONJAS.bmp"
    Set Image1.Picture = LoadPicture(arq) ' carrega a imagem
    Image1.PictureSizeMode = fmPictureSizeModeZoom
    
    Imagem = ThisWorkbook.Path & "\Planilha\" & Sheets("Controles").Range("L2") & ".bmp"

    If Dir(Imagem) <> "" Then ' verifica se o arquivo existe
      Set Image1.Picture = LoadPicture(Imagem) ' carrega a imagem
      Image1.PictureSizeMode = fmPictureSizeModeZoom
    End If
    
End Sub

Obrigado pela atenção

Abraço.

Claro, agora entendi

Você estava procurando uma solução para o Excel num site sobre Access.

Daí, não dava certo mesmo.

Boa sorte

Nb