テスト111

Option Explicit

Public FSO As Scripting.FileSystemObject
Public Ex As Excel.Application
Public wb2 As Workbook
Public Ex2 As Excel.Application
Public wb3 As Workbook

Sub Main()

'○3つのプロセスの並列処理

On Error GoTo Err_Exit

Dim wb As Workbook
Dim File As Variant
Dim File_Path As String
Dim Del_Path As String
Dim str_Path1 As String
Dim str_Path3 As String
Dim PDF_Path1 As String
Dim PDF_Path2 As String
Dim i As Long
Dim coll As Collection
Dim Close_wb As Variant
Dim j As Long

Set FSO = New Scripting.FileSystemObject
Set coll = New Collection
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

str_Path1 = "C:\Users\User\Desktop\並列テスト\Excelフォルダ1"
str_Path3 = "C:\Users\User\Desktop\並列テスト\並列処理.xlsm"
PDF_Path1 = "C:\Users\User\Desktop\並列テスト\PDFフォルダ1"

Del_Path = FSO.BuildPath(str_Path1, "*.xlsx")
On Error Resume Next
Kill Del_Path
On Error GoTo 0

Del_Path = FSO.BuildPath(PDF_Path1, "*.pdf")
On Error Resume Next
Kill Del_Path
On Error GoTo 0

On Error GoTo Err_Exit

j = 1
'------------------------------------
'第二プロセスのExcelファイル作成処理
Set Ex = New Excel.Application
Ex.Visible = True
Set wb2 = Ex.Workbooks.Open(Filename:=str_Path3, UpdateLinks:=False, ReadOnly:=True)

Ex.OnTime EarliestTime:=Now + TimeValue("00:00:01"), _
                               Procedure:=wb2.Name & "!Main2"
'------------------------------------

Set Ex2 = New Excel.Application
Ex2.Visible = True
Set wb3 = Ex2.Workbooks.Open(Filename:=str_Path3, UpdateLinks:=False, ReadOnly:=True)
                               
For i = 1 To 30
    '------------------------------------
    '第一プロセスのExcelファイル作成処理
    Set wb = Workbooks.Add
    
    File_Path = "Excelテスト" & i & ".xlsx"
    File_Path = FSO.BuildPath(str_Path1, File_Path)

    wb.SaveAs Filename:=File_Path
    '------------------------------------
    '第三プロセスのPDFファイル作成処理
    PDF_Path2 = FSO.BuildPath(PDF_Path1, FSO.GetBaseName(wb.Name) & ".pdf")

    Ex2.OnTime EarliestTime:=Now + TimeValue("00:00:01"), _
                               Procedure:="'PDF_Proc """ & File_Path & """,""" & PDF_Path2 & """'"
                               
    If j = 10 Then

        coll.Add wb
        
        For Each Close_wb In coll
        
            Close_wb.Close savechanges:=False
            
        Next Close_wb
        
        '初期化
        j = 1
        Set coll = New Collection
        
    Else
    
        coll.Add wb
        j = j + 1
    
    End If
    
Next i

For Each Close_wb In coll

    Close_wb.Close savechanges:=False
    
Next Close_wb

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Ex.Quit
Set Ex = Nothing

Ex2.Quit
Set Ex2 = Nothing
MsgBox "処理が終了しました。", vbInformation, "終了"

Exit Sub
'----------------------------
Err_Exit:
Ex2.Quit

End Sub

Public Sub Main2()

On Error GoTo Err_Exit

Dim wb As Workbook
Dim File As Variant
Dim File_Path As String
Dim Del_Path As String
Dim str_Path1 As String
Dim str_Path2 As String
Dim i As Long

Set FSO = New Scripting.FileSystemObject
Application.ScreenUpdating = False

str_Path2 = "C:\Users\User\Desktop\並列テスト\Excelフォルダ2"

Del_Path = FSO.BuildPath(str_Path2, "*.xlsx")

On Error Resume Next
Kill Del_Path
On Error GoTo 0

On Error GoTo Err_Exit

For i = 1 To 30

    Set wb = Workbooks.Add
    
    File_Path = "Excelテスト" & i & ".xlsx"
    File_Path = FSO.BuildPath(str_Path2, File_Path)

    wb.SaveAs Filename:=File_Path
    wb.Close savechanges:=False
    
Next i

ThisWorkbook.Close savechanges:=False

Exit Sub
'----------------------------
Err_Exit:
ThisWorkbook.Parent.Quit

End Sub

Public Sub PDF_Proc(ByVal File_Path As String, ByVal PDF_Path As String)

Dim wb As Workbook
Dim Ex As Excel.Application

Set wb = Workbooks.Open(File_Path)

wb.ActiveSheet.ExportAsFixedFormat _
     Type:=xlTypePDF, _
     Filename:=PDF_Path

wb.Close savechanges:=False

End Sub