Question

我试图根据文件名的第7个字符将最近重命名的文件从Temp文件夹移动到目标文件夹。

例如，每个文件名的第7个字符就是图形的大小。所以我想做的是，如果文件名的第7个chr是= A，然后将文件移到“ ... \ A-SIZE_8.5X11”文件夹。

*请注意，MainDir是在打印PDF时从autocad脚本创建的。

目前，我在If Mid(Dir(s, vbDirectory), x).Value = "A" Then遇到错误，说“类型不匹配”。任何反馈都非常感谢。

Sub MoveFiles()
Dim s As String, x As String
Dim LoginName As String, MainDir As String, 
SourceDir As String
Dim destDirA As String, destDirB As String, 
destDirC As String, destDirD As String

LoginName = UCase(GetUserID)
MainDir = "C:\Users\" & LoginName & "\Desktop\PDF\"
SourceDir = MainDir & "_Temp\"
destDirA = MainDir & "A-SIZE_8.5X11"
destDirB = MainDir & "B-SIZE_11X17"
destDirC = MainDir & "C-SIZE_17X22"
destDirD = MainDir & "D-SIZE_24X36"

s = (SourceDir & "\*.pdf?")
x = Mid(s, 7, 1) 'Find letter after S-000-

If Mid(Dir(s, vbDirectory), x).Value = "A" Then
    If Len(Dir(destDirA, vbDirectory)) = 0 Then MkDir destDirA
        Do
        Name SourceDir & s As destDirA & s & "\" & s
    Loop Until s = ""
End If

If Mid(Dir(s, vbDirectory), x).Value = "B" Then
    If Len(Dir(destDirB, vbDirectory)) = 0 Then MkDir destDirB
        Do
        Name SourceDir & s As destDirB & s & "\" & s
    Loop Until s = ""
End If

If Mid(Dir(s, vbDirectory), x).Value = "C" Then
    If Len(Dir(destDirC, vbDirectory)) = 0 Then MkDir destDirC
        Do
        Name SourceDir & s As destDirC & s & "\" & s
    Loop Until s = ""
End If

If Mid(Dir(s, vbDirectory), x).Value = "D" Then
    If Len(Dir(destDirD, vbDirectory)) = 0 Then MkDir destDirD
        Do
        Name SourceDir & s As destDirD & s & "\" & s
    Loop Until s = ""
End If
End Sub

已修改的If语句so循环在再次调用Dir之前结束。在线找到了部分代码，并尝试对其进行修改以使其起作用，但不确定如何解决。

Answer 1

看看下面的例子：

Option Explicit

Sub TestShellApp()

    Dim sSourceFolder As String
    Dim sTargetFolder As String
    Dim sSourcePattern
    Dim sTargetPath As String
    Dim oShellApp
    Dim oSourceFolder
    Dim oSourceFolderItems
    Dim oTargetFolder
    Dim sKey

    sSourceFolder = "C:\Test\Source\"
    sTargetFolder = "C:\Test\Target\"

    Set oShellApp = CreateObject("Shell.Application")
    Set oSourceFolder = oShellApp.Namespace((sSourceFolder))
    Set oSourceFolderItems = oSourceFolder.Items()
    With CreateObject("Scripting.Dictionary")
        .Item("A") = "A-SIZE_8.5X11"
        .Item("B") = "B-SIZE_11X17"
        .Item("C") = "C-SIZE_17X22"
        .Item("D") = "D-SIZE_24X36"
        For Each sKey In .Keys
            sTargetPath = sTargetFolder & .Item(sKey)
            SmartCreateFolder sTargetPath
            Set oTargetFolder = oShellApp.Namespace((sTargetPath))
            For Each sSourcePattern In Array( _
                    "??????" & sKey & "*", _
                    "????????" & sKey & "*" _
                )
                oSourceFolderItems.Filter 32 + 64 + 128, sSourcePattern
                oTargetFolder.MoveHere oSourceFolderItems, 16 + 1024
            Next
        Next
    End With
    MsgBox "Files moved"

End Sub

Sub SmartCreateFolder(sFolder)

    Static oFSO As Object

    If oFSO Is Nothing Then Set oFSO = CreateObject("Scripting.FileSystemObject")
    With oFSO
        If Not .FolderExists(sFolder) Then
            SmartCreateFolder .GetParentFolderName(sFolder)
            .CreateFolder sFolder
        End If
    End With

End Sub

根据文件名的第7个字符将文件移动到特定文件夹

1 个答案: