Question

每周我都要运行这个循环计数报告。报告完成后，我必须手动获取大约30个文件并按位置分组并压缩文件。我是VBA的新手，我正在尝试创建一个宏，该宏会自动对某组文件进行分组并将它们压缩在一起。此外，我需要能够添加或删除任何组合在一起的文件。下面是文件列表以及我如何将它们分组以及我尝试将它们保存到的位置。下面是我的一些代码。我知道它缺少一些东西。

以下是我正在谈论的两个文件。如果有人可以告诉我在宏中放入什么来完成这项工作并将其他文件分组到其他zip文件夹中会很棒。

名为CYC 06-06-11-18的Zip文件夹包含这些文件。 C06-06-11-18, C6K-06-11-18, C6M-06-11-18, C6V-06-11-18, CQU-06-11-18, CSU-06-11-18, T06-06-11-18,T6C-06-11-18, TSU-06-11-18.

名为CYC D1-06-11-18的Zip文件夹包含这些文件。 CD1-06-11-18, CS1-06-11-18, TD1-06-11-18, TS1-06-11-18.

这些文件都在一个文件夹中，zip文件夹可以位于同一个文件夹中，也可以位于新文件夹中。只要zip文件可以命名为＆＃34; CYC 06＆＃34;或＆＃34; CYC 11＆＃34;或＆＃34; CYC T1＆＃34;。我不必在zip文件夹中包含日期。

这些文件和zip文件夹保存在下面的文件路径中。如果可能，我想使用哪个。

S:\ACCT\Inventory Control & Product Costing\Inventory Control - Reporting\RM Cycle Count - Data Collection\Zip Files

这是我一直在使用的宏。

Dim x As Integer
Dim fs o As Object
Dim result As Boolean

Sub Folder Info()
Application. Screen  Updating   = False
'------------------------------------
'DECLARE AND SET VARIABLES
    Dim s t r Path As String
    s t r  Path = 
    x = 0
    Set fs o = Create Object    ("Scripting. File System Object")
'------------------------------------
'CHECK FOLDERS AND SUBFOLDERS
    result = Extract File Info    (s t r Path)
'------------------------------------
'CLEANUP
    Set fs o = Nothing
    Msg Box x & " files have been zipped."
Application. Screen Updating = True
End Sub


Private Function Extract File Info(fs pec)
    On Error Go To Err Handler
'------------------------------------
'DECLARE AND SET VARIABLES
    Dim f l d r As Object, fi As Object, s f l d r As Object, o App As Object
    Dim Filename, f name As String
    Set f l d r = fs o. Get Folder(fs pec)
'------------------------------------
'CHECK FILES IN TOP FOLDER
    If f l d r. Files. Count <> 0 Then
        For Each fi In f l d r. Files
            s = Split(fi, ".")
            If In  St r (1, fi, "(C06)" “(CK6)” “(CB6)” “(C6M)” “(C6V)” “(CQU)” “(CSU)” “(T06)” “(T6C)” “(TQU)” “(TSU)”, 1) > 0 And U Case(Left(s(1), 2)) = "XL" Then
                s = Split(fi, ".")
                Filename = s(0) & ".zip"
                New Zip (CYC 06)
                f name = fi
                Set o App = Create Object("Shell. Application")
                o App. Name space(Filename).Copy Here s(0) & "." & s(1) 'F Name (I C t r)
                x = x + 1
            End If
access not allowed:
        Next
    End If
'------------------------------------
'CHECK SUBFOLDERS
    If f l d r. Sub Folders. Count > 0 Then
        For Each s f l d r In f l d r. Sub Folders
            Extract File Info (s f l d  r) 'RECURSIVE CHECK
        Next
    End If
'------------------------------------
'CLEANUP
permission denied:
    Extract File Info = True
    Set f l d r = Nothing
Exit Handler:
    Application. Screen Updating = True
    Exit Function
'------------------------------------
'HANDLE RETURNED ERROR
Err Handler:
    If Err.Number = 70 Then 'permission denied
        Err. Clear
        Msg Box f spec & Ch r (13) & "Permission Denied"
        Resume permission  denied
    Else
        Msg Box Err. Number & ": " & Err. Description
        Resume Exit Handler
    End If
End Function

使用VBA压缩某些文件的宏

0 个答案: