Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


14622 / 76734 ←次へ | 前へ→

【67601】Re:個々のファイルを開かずにマクロの実行
回答  UO3  - 10/12/17(金) 12:20 -

引用なし
パスワード
   ▼はるな さん:

Sub Sample2()
 Dim myPath As String
 Dim workWB As Workbook
 Dim fsoFile As Object
 Dim Fso As Object
 Dim xlApp As Excel.Application

 myPath = "C:\Test"  '<== 実際のフォルダ名に
 Set xlApp = New Excel.Application
 Set Fso = CreateObject("Scripting.FileSystemObject")

 For Each fsoFile In Fso.GetFolder(myPath).Files
  If LCase(Fso.GetExtensionName(fsoFile.Name)) = "xls" Then
   Set workWB = xlApp.Workbooks.Open(Filename:=myPath & "\" & fsoFile.Name)
   If Not IsError(xlApp.Evaluate("[" & workWB.Name & "]管理シート上期!A1")) Then
    workWB.Sheets("管理シート上期").Copy After:=workWB.Sheets("管理シート上期")
    With workWB.ActiveSheet
     If IsError(xlApp.Evaluate("[" & workWB.Name & "]下期!A1")) Then .Name = "下期"
     .Cells.ClearContents  'もし内容のクリアがだめならカットしてください
    End With
    xlApp.DisplayAlerts = False
    workWB.SaveAs myPath & "\" & workWB.Name & "_下期.xls"
    workWB.Close
    xlApp.DisplayAlerts = True
   End If
  End If
 Next

 xlApp.Quit

 MsgBox "処理が終了しました"

End Sub

1 hits

【67585】個々のファイルを開かずにマクロの実行 はるな 10/12/16(木) 17:25 質問
【67586】Re:個々のファイルを開かずにマクロの実行 UO3 10/12/16(木) 20:45 発言
【67587】Re:個々のファイルを開かずにマクロの実行 UO3 10/12/16(木) 20:59 発言
【67598】Re:個々のファイルを開かずにマクロの実行 はるな 10/12/17(金) 10:27 発言
【67597】Re:個々のファイルを開かずにマクロの実行 はるな 10/12/17(金) 10:12 発言
【67590】Re:個々のファイルを開かずにマクロの実行 UO3 10/12/16(木) 23:31 回答
【67601】Re:個々のファイルを開かずにマクロの実行 UO3 10/12/17(金) 12:20 回答
【67602】Re:個々のファイルを開かずにマクロの実行 UO3 10/12/17(金) 12:22 発言

14622 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free