将多个图像文件上传到excel用户窗体VBA中的文件夹

时间:2019-01-15 01:06:15

标签: excel vba file-upload userform

我正在尝试在excel用户窗体中创建一个按钮,该按钮可以将多个图像上传到目标文件夹中。我通过以下代码不断收到错误“运行时错误'13'类型不匹配”:

Private Sub cmdUpload_Click()
Dim filepath As Variant
Dim InitFolder As String
Dim DestFolder As String
Dim FileName As String
Dim f As Variant
Dim fso As Object
Dim i As Integer

If dtSurveyID.Value = "" Then  'force people to enter name and date of sampling
    MsgBox ("First enter value for the 'Survey Identifier' field")
    Exit Sub
Else
Set fso = CreateObject("Scripting.FileSystemObject")
InitFolder = "C:\survey_photos\" ' where we store all the photos for this method - is just set to a local drive for testing!
DestFolder = InitFolder & dtSurveyID.Value 'name of folder for this beach and date
'copy the path of the different files the user wants to copy
filepath = Application.GetOpenFilename(FileFilter:="Tiff Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", FilterIndex:=2, Title:="Select the photos to upload", MultiSelect:=True)
If filepath = False Then
    Exit Sub
Else
    i = 0

    If Not fso.FolderExists(DestFolder) Then 'create the final destination folder, if required
        fso.CreateFolder (DestFolder)
    End If

    For Each f In filepath 'loop to go through all path contained in filepath selected by user and copy the files to select folder
    FileName = Dir(f)
    Call FileCopy(f, DestFolder & "\" & FileName)
    i = i + 1
    Next f

    MsgBox ("You have successfully copied " & i & " files to:" & vbCr & DestFolder)
    dtLinkToPicture.Value = DestFolder
End If End If End Sub

任何帮助将不胜感激!

0 个答案:

没有答案
相关问题