• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• Create MSAccess database of files on your HD with hyperlinks to open them from Access. Helps you ge

Create MSAccess database of files on your HD with hyperlinks to open them from Access. Helps you ge

Create MSAccess database of files on your HD with hyperlinks to open them from Access. Helps you get organized and find things.

API Declarations



Dim FSys As New Scripting.FileSystemObject
Dim curConn As New ADODB.Connection
Dim rstMac As New ADODB.Recordset
Dim curdb As DAO.Database





Rate Create MSAccess database of files on your HD with hyperlinks to open them from Access. Helps you ge

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'  ** MASTERING VB6            **
'  ** by Evangelos Petroutos
'  ** modified by mailto:[email protected]
'  ** ©SYBEX, 1998              **


'mod = make database with hyperlinks of your files
'helps me manage projects and keep track of files
'//////REF ADO, DAO & scripting run time ////////

Public Function mainSub()
Dim folderSpec As String
Set curdb = CurrentDb
Set curConn = New ADODB.Connection
With curConn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "data source= " & curdb.Name
.Open
End With
Set rstMac = New ADODB.Recordset
rstMac.CursorType = adOpenKeyset
rstMac.LockType = adLockOptimistic
rstMac.LockType = adLockOptimistic
rstMac.Open "Table1", curConn, , , adCmdTable 'modified text to table
If rstMac.RecordCount > 0 Then
rstMac.MoveFirst
Do While Not rstMac.EOF
rstMac.Delete
rstMac.Update
rstMac.MoveNext
Loop
End If
DoFileThing ("C:\") 'put your chosen path here
DoFileThing ("d:\") 'whatever "\\server\share\sub\" ok too
  rstMac.Close
curConn.Close
Set rstMac = Nothing
Set curConn = Nothing


End Function

Private Sub DoFileThing(thingsName)

    Set FSys = CreateObject("Scripting.FileSystemObject")
    folderSpec = thingsName
    folderSpec = UCase(folderSpec)
    Screen.MousePointer = vbHourglass
    ScanFolder (folderSpec)
    Screen.MousePointer = vbDefault
End Sub

Sub ScanFolder(folderSpec As String)
Dim thisFolder As Folder
Dim sFolders As Folders
Dim fileItem As file, folderItem As Folder
Dim AllFiles As Files
    Dim hlk As Hyperlink

    Set thisFolder = FSys.GetFolder(folderSpec)
    Set sFolders = thisFolder.SubFolders
    Set AllFiles = thisFolder.Files
    For Each folderItem In sFolders
        ScanFolder (folderItem.Path)
    Next
    For Each fileItem In AllFiles
        If Right(fileItem.Path, 3) = "mdb" Then
        '/// logic here for extensions as needed
    rstMac.AddNew
    rstMac![filename] = fileItem.Name
    rstMac![compath] = "#" & fileItem.Path & "#"
        'hint: the pound resolves to a hyperlink add
    rstMac![datetimedate] = fileItem.DateCreated
    rstMac![filesize] = fileItem.Size
    rstMac![modified] = fileItem.DateLastModified
    rstMac.Update
        End If
    Next
End Sub