照片链接问题

hciq

表中有字段编号和照片,照片字段是链接地址,另有一个存放照片的文件夹,照片文件名应当同表中编号一致,由于工作失误,有一些健作废的照片,如何把这些照片找出来,或者说怎样以照片文件夹中的照片文件名为字段建一个表?

fan0217

你可以通过搜索该文件夹的所以文件，然后通过ADO将图片文件的相关信息写入表中，这样就自动建立了他们之间的联系。

搜索文件夹可参考：该方法不会搜索其中子目录的文件

Type SearchInfo
    FileList As String
    FileCount As Integer
End Type

'===============================================================================
'-函数名称:     SearchFiles
'-功能描述:     遍历目录搜索指定格式的文件
'-输入参数说明: 参数1: 必选 strPath As String 需要搜索的文件夹路径
'               参数2: 可选 strSearch As String 搜索的关键字可使用通配符，不设置将搜索所有文件类型
'-返回参数说明:
'-使用语法示例: Call SearchFiles("C:\")  搜索C盘的所有文件
'-参考:         Office帮助
'-使用注意:     需要引用Microsoft Office 10.0 Object Library 或更高版本
'-兼容性:       XP,2003
'-作者:         fan0217@163.com
'-更新日期：    2006-05-26
'===============================================================================
Function fSearchFile(strPath As String, Optional strSearch As String = "*.*") As SearchInfo
On Error GoTo Err_fSearchFile
Dim fs As FileSearch, i As Long
Dim strFileList As String

Set fs = Application.FileSearch
    With fs
        .LookIn = strPath
        .FileName = strSearch
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
                strFileList = strFileList & .FoundFiles(i) & ";"
            Next i
        End If
    End With
   
    fSearchFile.FileList = strFileList
    fSearchFile.FileCount = fs.FoundFiles.Count

Exit_fSearchFile:
    Exit Function
   
Err_fSearchFile:
    MsgBox Err.Description, vbCritical, "fan0217"
    Resume Exit_fSearchFile

End Function

[此贴子已经被作者于2006-10-23 19:36:36编辑过]

fan0217

搜索文件夹其实还有其他方法，上面采用的是Office对象，该对象是在OfficeXP中增加的，所以只适用于2002以后的版本，还可以采用Dir配合Do...Loop来做，也可以用FSO对象来做，这可根据自己来选择。

hciq

谢谢版主,在EXCEL中能做吗?

fan0217

能

hciq

我的是2000,想用Dir和Do..,loop,请教用什么函数取文件的文件名取值?

fan0217

函数如下：

Function GetFileList(strFilePathName As String) As String
On Error GoTo Err_GetFileList
Dim strDir As String
    strDir = Dir(strFilePathName)
    Do
        GetFileList = GetFileList & strDir & ";"
        strDir = Dir
        i = i + 1
        If strDir = "" Then Exit Do
    Loop
   
Exit_GetFileList:
    Exit Function
   
Err_GetFileList:
    MsgBox Err.Description
    Resume Exit_GetFileList

End Function

调用：获取当前目录下的所有jpg文件

Dim strPath As String
If Right(CurrentProject.Path, 1) <> "\" Then
    strPath = CurrentProject.Path & "\"
Else
    strPath = CurrentProject.Path
End If

Me.List0.RowSource = GetFileList(strPath & "*.jpg")

joyark

正需要了解！谢谢！