Question

这更多是Excel VBA问题。我已经从PDM（solidworks）中导出了BOM表列表，并且编写了一个宏，该宏从该文件中删除了所有不重要的信息。我通过检查每一行是否包含4个允许的文本（SA，FG，IE和SP）之一来做到这一点

最后我只列出了我需要的零件编号：

示例：

FG.00.620.004
SA00078195
SA00110545
SA00100546
SP.00.103.123
SA00051007

我需要宏在文件夹“ Released Drawings”中搜索对应的pdf文件（solidworks工程图）的每一行，然后将其全部复制/粘贴到文件夹B中。（最好是在某个位置创建该文件夹加上FG行的值）

pdf文件具有以下名称：（例如）

FG.00.620.004_C.pdf
SA00078195_A.pdf
SA00110545_D.pdf
SA00100546_A.pdf
SP.00.103.123_A.pdf
SA00051007_B.pdf

因此，它需要查找文件的最新版本（文件以_D结尾时，还有一个_C变体。它需要选择D变体。“ D”也将具有最新日期）

更新1，使我自己创建文件夹（循环）：

If InStr(StrConv(ActiveCell, vbUpperCase), "FG") = 1 Then           

Fldr_name = "D:\Spare Part Generator\MRD Final\" & ActiveCell

FSO.CreateFolder (Fldr_name)

代码：

Public fso As New FileSystemObject
Sub MARS_FRS()


Dim lLoop As Long
Dim rFoundCell As Range
Dim nRow As Integer
Dim u As Integer
Dim v As Integer
Dim objFolder As Folder
Dim objFile As file
Dim fitem As String
Dim Fldr_name As String
Dim fso As Object
Dim Origin As String

u = 0
v = 1

Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Origin = "D:\Spare Part Generator\Manuals Release Drawings\"
Fldr_name = "D:\Spare Part Generator\MRD Final" 'Destination

' Selecting range

nRow = Worksheets(ActiveSheet.Name).Range("A1").End(xlDown).Row


' Deleting all columns besides column D
If IsEmpty(Range("L1").Value) = True Then
Else
Columns("A:C").Select
Selection.Delete Shift:=xlToLeft
Columns("B").Select
Selection.Delete Shift:=xlToLeft
Columns("C:J").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
End If


' Find all cells containing SA, IE, FM, SP and placing them in correct folder

'Starting position
Range("A1").Select

'Keep looping until the activecell is empty.
Do Until u = nRow
    file = Dir(Origin)


    u = u + 1

    If InStr(StrConv(ActiveCell, vbUpperCase), "SA") = 1 Then
        'Copy file
        While (file <> "")
            If InStr(file, ActiveCell) > 0 Then
            FileCopy Origin & file, Fldr_name & "\" & file
            End If

           file = Dir
        Wend

    ActiveCell.Offset(1, 0).Select
    Else
        If InStr(StrConv(ActiveCell, vbUpperCase), "FM") = 1 Then
        v = v + 1
            ' check to find only the first FM in case there are multiple
            If v = 2 Then
            Fldr_name = "D:\Spare Part Generator\MRD Final\" & ActiveCell
                If (fso.FolderExists(Fldr_name)) Then
                Else
                fso.CreateFolder (Fldr_name)
            End If
            Else
            End If

        'Copy file
        While (file <> "")
            If InStr(file, ActiveCell) > 0 Then
            FileCopy Origin & file, Fldr_name & "\" & file
            End If

           file = Dir
        Wend

        ActiveCell.Offset(1, 0).Select

        Else
            If InStr(StrConv(ActiveCell, vbUpperCase), "IE") = 1 Then

            'Copy file
            While (file <> "")
                If InStr(file, ActiveCell) > 0 Then
                FileCopy Origin & file, Fldr_name & "\" & file
                End If

               file = Dir
            Wend
            ActiveCell.Offset(1, 0).Select
            Else
                If InStr(StrConv(ActiveCell, vbUpperCase), "SP") = 1 Then
                    'Copy file
                While (file <> "")
                    If InStr(file, ActiveCell) > 0 Then
                    FileCopy Origin & file, Fldr_name & "\" & file
                    End If

                   file = Dir
                Wend
                ActiveCell.Offset(1, 0).Select
                Else
                ActiveCell.ClearContents
                ActiveCell.EntireRow.Select
                Selection.Delete Shift:=xlUp
                End If

            End If

        End If

    End If

Loop


' Save

'ActiveWorkbook.Save

End Sub

让Excel在文件夹A中查找pdf文件，然后根据xlsx文件中的列表将其复制到文件夹B中

0 个答案: