HyperLinks? (1 Viewer)

[NewfieSarah]

Hey all,
I have a table for my documents and I have to add all these documents which need to be entered into the table, is there a faster way then right click edit hyperlink and go through the folders and find the file? Since I have a lot of doc this will take a while so I was wondering if there was another way? Thanks

 

[Bat17]

Here is some code I use to pull out file names from folders/sub folders and add them to a table as hyperlinks. You may be able to hack it to something that you can use

Option Compare Database
Option Explicit

'Using the FSO requires setting a reference to "Microsoft Scripting Runtime".

'Module-Level Variables/Constants
Private fso As Scripting.FileSystemObject
'Change the following constants to the appropriate folder names
Const cstrMSDSpath As String = "\\Murph\Health\COSHH Database\SUPPLIER'S  MSDS"

'This sub gets the whole process started...
Sub UpdateMsdsHyperlinks()
Dim FolderMSDS As Scripting.Folder
Dim errorMes As Variant
On Error GoTo Link_Error
DoCmd.SetWarnings False
DoCmd.OpenQuery ("qryDeleteMSDS")
DoCmd.SetWarnings True
Set fso = CreateObject("Scripting.FileSystemObject")
Set FolderMSDS = fso.GetFolder(cstrMSDSpath)
funFindMSDS FolderMSDS
Links_Exit:
Exit Sub
Link_Error:  ' Error-handling routine.
   Select Case Err.Number  ' Evaluate error number.
      Case 3109  ' no permision to delete records.
        GoTo Links_Exit
      Case Else
        errorMes = MsgBox("Error Number " & Err.Number, vbCritical, "Code Error")
        GoTo Links_Exit
   End Select
  

End Sub

'This sub does all the work
Private Sub funFindMSDS(FolderMSDS As Scripting.Folder)
Dim SubFolderMSDS As Scripting.Folder
Dim oFile As Scripting.File
Dim strfile As String
Dim dbs As Database
Dim rstRWMT As Recordset

Set dbs = CurrentDb
Set rstRWMT = dbs.OpenRecordset("tblSuppliersMSDS")
With rstRWMT
   'For each subfolder in the main folder, run this sub recursively
   If FolderMSDS.SubFolders.count Then
        For Each SubFolderMSDS In FolderMSDS.SubFolders
            funFindMSDS SubFolderMSDS
        Next 'SubFolderMSDS
   End If
   
   'scan each file in the folder and to see if it is an MSDS
   For Each oFile In FolderMSDS.Files
        strfile = UCase$(oFile.Name)
        If Left(strfile, 1) = "F" Then
            If Left(strfile, 2) = "FT" Then
                If IsNumeric(Mid(strfile, 3, 5)) Then
                  .AddNew
                  !RWMTID = Left(strfile, 6)
                  !HypPath = "#" & oFile.Path & "#"
                  .Update
               End If 'IsNumeric
            ElseIf Left(strfile, 3) = "FWE" Then
                  .AddNew
                  !RWMTID = Left(strfile, 7)
                  !HypPath = "#" & oFile.Path & "#"
                  .Update
            ElseIf IsNumeric(Mid(strfile, 2, 4)) Then
                  .AddNew
                  !RWMTID = Left(strfile, 5)
                  !HypPath = "#" & oFile.Path & "#"
                  .Update
            End If
        End If
   Next 'oFile
   .Close
End With
Set rstRWMT = Nothing
Set dbs = Nothing
End Sub

Peter