使用文件选择器将图像文件从一个位置复制到另一个位置

Question

我在表中有一个名为itemImage的图像控件设置为ItemImage字段。我使用file picker浏览到一个位置并复制一个图像，然后将它保存到另一个位置，并使用textbox值重命名它，然后将它的完整位置添加到表中。

问题：

access上的image control与.jpg文件一起工作吗？还是我需要转换为.bmp？如果是这样，那么当我将文件从一个位置复制到另一个位置时，如何维护文件扩展名呢？是否有更好或更有效的方法来完成这类任务？

我当前的尝试复制该图像，但没有在窗体上显示已知的.bmp图像。请见下文：

Private Sub itemImage_DblClick(Cancel As Integer)
On Error GoTo 0
Dim ofd As Object
Dim fso As Object
Dim theFile As String
Dim theFileLocation As String
Dim filePath As String
Dim fullFileName As String
Dim theFileName As String

Set ofd = Application.FileDialog(3)
ofd.AllowMultiSelect = False
ofd.Show
If ofd.SelectedItems.Count = 1 Then
theFile = Mid(ofd.SelectedItems(1), InStrRev(ofd.SelectedItems(1), "\") + 1, Len(ofd.SelectedItems(1)))
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
filePath = ofd.SelectedItems(1)

CopyImage filePath, Me.donationNumber & Mid(ofd.SelectedItems(1), InStrRev(ofd.SelectedItems(1), "."))

CurrentDb.Execute "UPDATE tblDonatedItems SET ItemImage =  '" & Application.CurrentProject.Path + "\ItemImages\" + donationNumber.Value + Mid(ofd.SelectedItems(1), InStrRev(ofd.SelectedItems(1), ".")) & "' WHERE DonationNumber = '" & Me.donationNumber.Value & "'", dbFailOnError

Else
   MsgBox "Image update Cancel!"
End If

End Sub

Sub CopyImage(filePath As String, fileName As String)
Dim fs As Object
Dim images_path As String
images_path = CurrentProject.Path & "\ItemImages\"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile filePath, images_path & fileName
Set fs = Nothing

End Sub

Answer 1

据我所知，实际问题在于jpeg文件扩展名，而不是jpg。Access不在图像控制中呈现jpeg图像。我还注意到，简单地将文件扩展名从jpeg更改为jpg允许访问来呈现文件。因此，请考虑：

strExt = Mid(ofd.SelectedItems(1), InStrRev(ofd.SelectedItems(1), "."))
If strExt = ".jpeg" Then strExt = ".jpg"

或者不用使用strExt，如果是有条件的，只需使用替换()函数即可。此外，使用FileCopy将类似于：

FileCopy filePath, images_path & Replace(fileName, ".jpeg", ".jpg")