Convert VB Code to use in Access

Hi,

i am currently using the below code in excel to get a list of files which are on one of my drives.

In access i have created a table with all the headers that are getting created in the Sub List_Of_Files_In_Folder(). Can someone help me build this code to work in access?

Sub List_Of_Files_In_Folder()
    'add headers
    Sheets("Files on Drive").Select
    Columns("A:L").Delete
    Range("A1").Formula = "Current File Path:"
    Range("B1").Formula = "Destination File Path:"
    Range("C1").Formula = "Parent Folder:"
    Range("D1").Formula = "File Name:"
    Range("E1").Formula = "File Size:"
    Range("F1").Formula = "File Type:"
    Range("G1").Formula = "Date Created:"
    Range("H1").Formula = "Date Last Accessed:"
    Range("I1").Formula = "Date Last Modified:"
    Range("J1").Formula = "Attributes:"
    Range("K1").Formula = "Short File Name:"
    Range("L1").Formula = "Archiving Status (Yes/No):"
    Range("A1:L1").Font.Bold = True
    ListFilesInFolder "I:\", True
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    r = Range("A65536").End(xlUp).Row + 1
    For Each FileItem In SourceFolder.Files
        Cells(r, 1).Formula = FileItem.Path
        Cells(r, 2).Formula = "D:\Archiving " & Left(FileItem.Path, 1) & " Drive" & Mid(FileItem.Path, 3, (Len(FileItem.Path)))
        Cells(r, 3).Formula = Mid(FileItem.Path, 4, (InStr(4, FileItem.Path, "\") - 4))
        Cells(r, 4).Formula = FileItem.Name
        Cells(r, 5).Formula = FileItem.Size
        Cells(r, 6).Formula = FileItem.Type
        Cells(r, 7).Formula = FileItem.DateCreated
        Cells(r, 8).Formula = FileItem.DateLastAccessed
        Cells(r, 9).Formula = FileItem.DateLastModified
        Cells(r, 10).Formula = FileItem.Attributes
        Cells(r, 11).Formula = FileItem.ShortPath & FileItem.ShortName
        r = r + 1
    Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If
    Columns("A:L").AutoFit
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    ActiveWorkbook.Saved = True
    Cells(1, 1).Select
End Sub
SaichandAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
RobSampsonConnect With a Mentor Commented:
Hi, maybe this will work.  You'll need to check your table and field names.

Regards,

Rob.
Sub List_Of_Files_In_Folder()
    ListFilesInFolder "I:\", True
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    For Each FileItem In SourceFolder.Files
    	CurrentDb.Execute "INSERT INTO MyTable (CurrentFilePath,DestinationFilePath,ParentFolder,FileName,FileSize,FileType,DateCreated,DateLastAccessed,DateLastModified,Attributes,ShortFileName) " & _
    		"VALUES (" & _
    		"'" & FileItem.Path & "'," & _
    		"'" & "D:\Archiving " & Left(FileItem.Path, 1) & " Drive" & Mid(FileItem.Path, 3, (Len(FileItem.Path))) & "'," & _
    		"'" & Mid(FileItem.Path, 4, (InStr(4, FileItem.Path, "\") - 4)) & "'," & _
    		"'" & FileItem.Name & "'," & _
    		"'" & FileItem.Size & "'," & _
    		"'" & FileItem.Type & "'," & _
    		"'" & FileItem.DateCreated & "'," & _
    		"'" & FileItem.DateLastAccessed & "'," & _
    		"'" & FileItem.DateLastModified & "'," & _
    		"'" & FileItem.Attributes & "'," & _
    		"'" & FileItem.ShortPath & FileItem.ShortName & "'" & _
    		")"
    Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

Open in new window

0
 
SaichandAuthor Commented:
it worked perfectly fine... thanks a lot...

i have another question... in the belew piece of code, how would i give referance of a text box on a form in place of I:\

Sub List_Of_Files_In_Folder()
    ListFilesInFolder "I:\", True
End Sub

0
 
SaichandAuthor Commented:
nevermind i got it.. thanks..
0
 
SaichandAuthor Commented:
I get the perfect solution from RobSampson
0
 
RobSampsonCommented:
Thanks for the grade.

Regards,

Rob.
0
All Courses

From novice to tech pro — start learning today.