MS Access VBA从表中查找图像文件名，搜索并复制它们

问题描述：

我正在使用Access2013。我在一个表中有一个图像列表。然后，我需要搜索一组文件夹（包括子文件夹），找到图像并将其复制到新目录。包含图像名称的表未引用文件路径。

I'm using Access 2013. I have a list of images in a table. I then need to search through a set of folders (including sub folders), locate the images and copy them to a new directory. The table that contains the image names does not reference the file path.

实现此目的的最佳方法是什么？是否可以遍历表并执行搜索，还是我将其分解并手动定位每个文件并更新标记以表示存在，然后返回并复制它们？

What is the best way to achieve this? Is it possible to loop through the table and perform the search, or would I have break it down and manually locate each file and update a flag to say it exists, then go back and copy them?

不确定如何执行此操作，但是会感谢您的任何想法。

Not sure how to do this but would appreciate any ideas.

谢谢。

答

对于某些导入程序，我不得不操作文件，创建副本等，并且创建了一些功能来帮助处理，您可能会发现其中的一些用途：

For some import programs I had to manipulate files, create copies etc. and I created some functions to help process, you might find some use in them:

要从VBA创建文件夹：

To create folder from VBA:

Public Function folderCreate(filePath As String) As Boolean
    'define variables
    Dim fsoFold As Object

    'set file system object
    Set fsoFold = CreateObject("Scripting.FileSystemObject")

    If Not fsoFold.folderExists(filePath) Then
        'check if folder exists
        fsoFold.CreateFolder (filePath)
    End If

    folderCreate = True

    Set fsoFold = Nothing

End Function

要检查文件夹是否存在：

To check if folder exists:

Public Function folderExists(folderPath As String) As Boolean
    'define variables
    Dim fso As Object

    'set file system object
    Set fso = CreateObject("Scripting.FileSystemObject")

    'check if file exists
    If fso.folderExists(folderPath) Then
        folderExists = True
    Else
        folderExists = False
    End If

    Set fso = Nothing

End Function

要检查文件是否存在：

Public Function fileExists(filePath As String) As Boolean
     'define variables
     Dim fso As Object

    'set file system object
    Set fso = CreateObject("Scripting.FileSystemObject")

    'check if file exists
    If fso.fileExists(filePath) Then
        fileExists = True
    Else
        fileExists = False
    End If

    Set fso = Nothing

End Function

与此类似，使用movefile将其移动到新位置。

Similar to this, use movefile to move it to new location.

fso.movefile strFullPath, strFullBackUp

编辑：以下子文件将通过给定的文件夹并列出所有JPG图像-此代码只是示例如何查找文件，文件夹以及如何递归地遍历它们。

Public Sub listImages(folderPath As String)

    'define variables
    Dim fso As Object
    Dim objFolder As Object
    Dim objFolders As Object
    Dim objF As Object
    Dim objFile As Object
    Dim objFiles As Object
    Dim strFileName As String
    Dim strFilePath As String
    Dim myList As String

    'set file system object
    Set fso = CreateObject("Scripting.FileSystemObject")

    'set folder object
    Set objFolder = fso.GetFolder(folderPath)

    'set files
    Set objFiles = objFolder.files
    Set objFolders = objFolder.subfolders

    'list all images in folder
    For Each objFile In objFiles

        If Right(objFile.Name, 4) = ".jpg" Then
            strFileName = objFile.Name
            strFilePath = objFile.Path
            myList = myList & strFileName & " - " & strFilePath & vbNewLine
        End If

    Next

    'go through all subflders
    For Each objF In objFolders

        'call same procedure for each subfolder
        Call listImages(objF.Path)

     Next

     Debug.Print myList

     Set objFolder = Nothing
     set objFolders = Nothing
     Set objFile = Nothing
     set objF = Nothing
     Set fso = Nothing


End Sub

MS Access VBA从表中查找图像文件名，搜索并复制它们

相关推荐