Question

我在这里找到了一些VBA例程，然后尝试使它们适应我的情况。效果很好，但是当我尝试将文件复制到使用其名称中的常量“ process”和变量[ID]字段创建的文件夹时，会出现错误消息。

此行中有错误

FileCopy f.SelectedItems（i），“ O：\ docs \ process \”和（me.ID）

Private Sub Comando356_Click()
' lets say my current record has an ID field value 345
' The routine will check if folder O:\docs\process345 exists
' If the folder does not exist, then the folder is created:

If 
Len(Dir("O:\docs\process" & (Me.ID), vbDirectory)) = 0 Then
MkDir "O:\docs\process" & (Me.ID)
End If

‘ So far it works perfectly: if the folder does not exist, is created

Dim f As Object
Set f = Application.FileDialog(3)
f.AllowMultiSelect = False
If f.Show Then
    For i = 1 To f.SelectedItems.Count
        sFile = Filename(f.SelectedItems(i), sPath)

' My problem is the next line: folder O:\docs\process345 exists but I get an error 76 “Path not Found”       

FileCopy f.SelectedItems(i), "O:\docs\process" & (me.ID)

    Next
End If
End Sub

Public Function Filename(ByVal strPath As String, sPath) As String
    sPath = Left(strPath, InStrRev(strPath, "\"))
    Filename = Mid(strPath, InStrRev(strPath, "\") + 1)
End Function

Answer 1

添加斜线并添加FileName

Private Sub Comando356_Click()
' lets say my current record has an ID field value 345
' The routine will check if folder O:\docs\process345 exists
' If the folder does not exist, then the folder is created:

If 
Len(Dir("O:\docs\process" & (Me.ID), vbDirectory)) = 0 Then
MkDir "O:\docs\process" & (Me.ID)
End If

‘ So far it works perfectly: if the folder does not exist, is created

Dim f As Object
Set f = Application.FileDialog(3)
f.AllowMultiSelect = False
If f.Show Then
    For i = 1 To f.SelectedItems.Count
        sFile = Filename(f.SelectedItems(i), sPath)

' My problem is the next line: folder O:\docs\process345 exists but I get an error 76 “Path not Found”       

'   add some debugging
Debug.Print ("in=" & f.SelectedItems(i) & "  out=" &  "O:\docs\process" & (me.ID) & "\" & sFile)
'   add a Slash and add the FileName
FileCopy f.SelectedItems(i), "O:\docs\process" & (me.ID) & "\" & sFile  ' <<<<

    Next
End If
End Sub

Public Function Filename(ByVal strPath As String, sPath) As String
    sPath = Left(strPath, InStrRev(strPath, "\"))
    Filename = Mid(strPath, InStrRev(strPath, "\") + 1)
End Function

将文件复制到使用表字段作为名称

1 个答案: