vba - 将文件复制到使用表字段作为名称的一部分创建的文件夹中

Question

我在这里找到了一些 VBA 例程，并尝试使它们适应我的情况。它工作正常，但是当我尝试将文件复制到使用其名称中的常量“进程”和变量 [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

标签： vbams-access

Answer 1

添加斜杠并添加文件名

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