Sélecteur d'accès et de fichiers

Question

Je souhaite remplir une zone de texte avec un chemin de fichier afin que je puisse ensuite ajouter le chemin de fichier en tant que lien hypertexte dans un enregistrement.

J'ai créé un bouton et a écrit ce sous-programme:

Private Sub Browsebutt_Click() 
Dim fd As Object 
Set fd = Application.FileDialog(3) 'msoFileDialogFilePicker 
With fd 
    .Filters.Clear 
    .InitialFileName = CurrentProject.Path & "\" 
    .Title = "Select File" 
    .AllowMultiSelect = False 
    .ButtonName = "Select" 
    .Filters.Add "All Files (*.*)", "*.*" 
    '.InitialView = msoFileDialogViewList' 
    If .Show Then 
     Me.Offlink = .SelectedItems(1) 
     Else 
     Exit Sub 
    End If 

End With 

Tout semble bien, mais la question est quand je navigue à quelque chose stocké dans ma compagnie NAS. Le chemin ressemble à ceci:

Z: \ Dossier1 \ Fichier

Il ne fonctionne pas sur un clic, si au lieu de cela, j'utilise le glisser-déposer fonction directement dans la table d'accès (non sous la forme) J'obtenir quelque chose comme ceci:

\ 192.168.0.155 \ archive \ Dossier1 \ fichier

et il fonctionne en fait, quand je clique sur le lien, il ouvre mon dossier.

Donc je me demandais s'il y avait un moyen d'avoir le sélecteur de fichiers pour fournir le chemin avec IP complète.

Answer 1

Répondre à cela nécessitera quelques étapes, et pourrait dépendre un peu de votre configuration:

Vous ne pouvez pas modifier le comportement du sélecteur de fichier un lot, donc je vais changer la lettre de lecteur pour le chemin UNC . Selon la façon dont votre lecteur est mis en correspondance, il soit renvoyer un nom de serveur (comme \\MyServer ou \\www.AnUrl.tld) ou une adresse IP

D'abord, je vais utiliser quelques fonctions d'aide, j'ai trouvé here et adapté à utiliser des fixations tardives et augmenter la convivialité.

Aide 1: Entrée: un chemin complet. Sortie: la lettre de lecteur à partir de ce chemin

Public Function ParseDriveLetter(ByVal path As String) As String 
    'Get drive letter from path 
    ParseDriveLetter = vbNullString 
    On Error GoTo err_ParseDriveLetter 
    Dim oFileSystem As Object ' Scripting.FileSystemObject 
    Set oFileSystem = CreateObject("Scripting.FileSystemObject") 
    Dim oFolder As Object 'Scripting.Folder 
    ' Next line throws error if mapping not available 
    Set oFolder = oFileSystem.GetFolder(path) 
    If (oFolder Is Nothing) Then 
     Debug.Print "ParseDriveLetter: Folder '" & path & "' is invalid" 
    Else 
     ParseDriveLetter = oFileSystem.GetDriveName(oFolder.path) 
    End If 
    Set oFolder = Nothing 
    Set oFileSystem = Nothing 
    Exit Function 

err_ParseDriveLetter: 
    Select Case Err.Number 
    Case 76: 
     ' Path not found -- invalid drive letter or letter not mapped 
    Case Else 
     MsgBox "Error no. " & CStr(Err.Number) & ": " & Err.Description & vbNewLine & _ 
      "Was caused by " & Err.Source, vbOKOnly Or vbExclamation, "Error in function ParseDriveLetter" 
    End Select 
End Function 

Helper 2: Entrée: une lettre de lecteur à partir d'un lecteur réseau mappé. Sortie: l'emplacement du lecteur est mis en correspondance avec

Public Function GetMappedPathFromDrive(ByVal drive As String) As String 
    Dim oWshNetwork As Object 'New WshNetwork 
    Dim oDrives As Object 'New WshCollection 
    Set oWshNetwork = CreateObject("WScript.Network") 
    ' The EnumNetworkDrives method returns a collection. 
    ' This collection is an array that associates pairs of items ? network drive local names and their associated UNC names. 
    ' Even-numbered items in the collection represent local names of logical drives. 
    ' Odd-numbered items represent the associated UNC share names. 
    ' The first item in the collection is at index zero (0) 
    Set oDrives = oWshNetwork.EnumNetworkDrives 
    Dim i         As Integer 
    For i = 0 To oDrives.Count - 1 Step 2 
     ' Drive is oDrives.Item(i), UNC is oDrives.Item(i + 1) 
     If (0 = StrComp(drive, oDrives.Item(i), vbTextCompare)) Then 
      ' We have matched the drive letter. Copy the UNC path and finish 
      GetMappedPathFromDrive = oDrives.Item(i + 1) 
      Exit For 
     End If 
    Next 
    Set oDrives = Nothing 
    Set oWshNetwork = Nothing 
End Function 

Et maintenant, la mise en œuvre dans votre code:

Me.Offlink = Replace(.SelectedItems(1), ParseDriveLetter(.SelectedItems(1)), GetMappedPathFromDrive(ParseDriveLetter(.SelectedItems(1)))) 

Notez que si cela retourne le nom du serveur au lieu de l'adresse IP, vous peut utiliser le post @ June7 référencé pour obtenir l'adresse IP.