Sub Syukei()
Dim int_fld,out_fld,out_fl As String
Dim wb,fs,gfld,wb1 As Object
Dim orowcnt,endrowcnt As Long
in_fld_obj = "C:\請求書"
out_fld = "C:\出力先"
out_fl = "売上集計表.xlsx"
For Each wb In Workbooks
If wb.Name = out_fl Then wb.Close
Next wb
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(out_fld & "\" & out_fl) = False Then
Set wb = Workbooks.Add
wb.SaveAs out_fld & "\" & out_fl
wb.WorkSheets(1).Name = "集計表"
Else
Kill out_fld & "\" & out_fl
Set wb = Workbooks.Add
wb.SaveAs out_fld & "\" & out_fl
wb.Worksheets(1).Name = "集計表"
End If
With wb.Worksheets("集計表")
.Range("A1") = "得意先"
.Range("B1") = "請求日"
.Range("C1") = "請求金額"
.Range("D1") = "ファイル更新日"
.Range("E1") = "ファイル名"
.Range("F1") = "シート名"
Set gfld = fs.GetFolder(in_fld)
orowcnt = 2
For Each vBk In gfld.Files
If Left(vBk, 2) <> "~$" And InStr(Right(vBk, Len(vBk) - InStrRev(vBk, ".")), "xl") > 0 Then
Set wb1 = Workbooks.Open(vBk.Path)
For Each ws In wb1
If ws.Range("G3") = "請求書" Then
wb.Range("A" & orowcnt) = ws.Range("A5")
wb.Range("B" & orowcnt) = ws.Range("M4")
wb.Range("C" & orowcnt) = ws.Range("C7")
wb.Range("D" & orowcnt) = vBk.DateLastModified
wb.Range("E" & orowcnt) = vBk.Name
wb.Range("F" & orowcnt) = ws.Name
orowcnt = orowcnt + 1
End If
Next ws
End If
wb1.Close savechanges:=False
Next vBk
Set fs = nothing
endrowcnt = wb.WorkSheets("集計表").Range("A" & Cells.Rows.Count).End(xlUp).Row
wb.WorkSheets("集計表").Range("A1:F" & endrowcnt).Borders.LineStyle = xlContinuous
wb.WorkSheets("集計表").Range("A1:F" & endrowcnt).Borders.Weight = xlThin
wb.WorkSheets("集計表").Range("A1:F" & endrowcnt).Borders.Color = RGB(166,166,166)
wb.Activate
ActiveSheet.Range("B2").Select
ActiveWindow.FreezePanes = True
wb.Save
Set wb = Nothing
MsgBox "End!"
End With
End Sub