id:ohtsu6
ポイントあり250ptベストアンサーあり
コンピュータ

エクセルで、

a.xlsを開いたときに自動的行いたい動作があります。

1.
「C:\」に保存してある「b.xls」のバックアップを
「C:\back」に「b_作業当日の日付.xls」という名前で保存したい

2.
「C:\」に保存してある「c.xls」のシート「0811」を
「C:\data」に保存してある「d.xls」にコピーしたい

終了後エクセルを終了させたいです。

どうぞよろしくお願いいたします。

回答の条件
  • 1人2回まで
  • 登録：
  • 終了：2008/11/12 23:03:26
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:Mook No.3

回答回数1314ベストアンサー獲得回数393

ポイント100pt

EXCEL を使用しなくてもできそうですが、とりあえずEXCELを使用した実装です。

ThisWorkbook の下に保存して実行ください。


補足はコメントで行いますので、有効にお願いいたします。

Private Sub Workbook_Open()
'--- ファイル名の定義
    Const SRC_FILE_B = "C:\b.xls"
    Const SRC_FILE_C = "C:\c.xls"
    Const SRC_FILE_D = "C:\d.xls"
'--- シート名の定義
    Const SRC_SHEET = "0811"
    

'1.
'「C:\」に保存してある「b.xls」のバックアップを
'「C:\back」に「b_作業当日の日付.xls」という名前で保存したい
    Dim dstFile As String
    dstFile = "C:\back\b_" & Format(Date, "YYYYMMDD") & ".xls"
    If Dir(dstFile, vbNormal) <> "" Then
        MsgBox "[" & dstFile & "]は既に存在しています。"
        Exit Sub
    End If
    FileCopy SRC_FILE_B, dstFile

'2.
'「C:\」に保存してある「c.xls」のシート「0811」を
'「C:\data」に保存してある「d.xls」にコピーしたい

    If Dir(SRC_FILE_C, vbNormal) = "" Then
        MsgBox "[" & SRC_FILE_C & "]はありません。"
        Exit Sub
    End If
    
    If Dir(SRC_FILE_D, vbNormal) = "" Then
        MsgBox "[" & SRC_FILE_D & "]はありません。"
        Exit Sub
    End If

    Dim srcWB As Workbook
    Set srcWB = Workbook.Open(SRC_FILE_C)
    
    Dim dstWB As Workbook
    Set dstWB = Workbook.Open(SRC_FILE_D)

    
    srcWB.Worksheets(SRC_SHEET).Copy after:=dstWB.Worksheets(dstWB.Worksheets.Count)
    
    dstWB.Save
    dstWB.Close
    
    Application.DisplayAlerts = False
    srcWB.Close

'--- 終了メッセージ：不要なら次行を削除
    MsgBox "処理を終了しました。"

'3.
'終了後エクセルを終了させたいです｡
    ThisWorkbook.Saved = True
    ThisWorkbook.Close False

    ' 他にブックが開いていなければ、Excelを終了する
    If Workbooks.Count <= 1 Then
        Application.Quit
    End If
End Sub

http://officetanaka.net/excel/vba/statement/FileCopy.htm

http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_800_060.html

id:ohtsu6

どうもありがとうございます。

ファイル名やシート名がたまに変わることがあるので、

定義はとても便利そうです。

Set srcWB = Workbook.Open(SRC_FILE_C)

でエラーになってしまいましたが、

Set srcWB = Workbooks.Open(SRC_FILE_C)

とすることで実行することができるようになりました。

2008/11/12 23:02:29

その他の回答（2件）

id:pahoo No.1

回答回数5960ベストアンサー獲得回数633

ポイント50pt

「質問１」のマクロは下記の通り。

コピー先のファイル名の年月日は "b_yyyymmdd.xls" 形式となります。

Sub Auto_Open()
    Dim sour, dest As String
    sour = "C:\b.xls"    'コピー元
    dest = "C:\b_" & Year(Date) & Month(Date) & Day(Date) & ".xls"  'コピー先
    FileCopy sour, dest
    Application.Quit
End Sub

「質問２」について確認をお願いします。

「C:\data」に保存してある「d.xls」にコピーしたい

これは、ブック "c:\data\d.xls" の中にワークシート "0811" を追加していくというイメージですか？


いずれも、Excel VBAよりWSHで書いた方がいいような気がしますが‥‥。

id:ohtsu6

どうもありがとうございます。

>これは、ブック "c:\data\d.xls" の中にワークシート "0811" を追加していくというイメージですか？

ということでした。

WSHでも可能とのことですが、

今後必要そうになったら、

再度質問させていただきます。

どうもありがとうございます。

2008/11/12 22:53:57
id:SALINGER No.2

回答回数3454ベストアンサー獲得回数969

ポイント100pt

ThisWorkbookのWorkbook_Open()イベントに次にコードを入れてください。

1.

Private Sub Workbook_Open()
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FSO.GetFile("C:\b.xls").Copy "C:\back\b_" & Format(Date, "yyyymmdd") & ".xls"
    
    Set FSO = Nothing
    Application.Quit
End Sub

2.

Private Sub Workbook_Open()
    Workbooks.Open "C:\c.xls"
    Workbooks.Open "C:\data\d.xls"
    Workbooks("c.xls").Worksheets("0811").Copy Workbooks("d.xls").Worksheets(1)
    Application.DisplayAlerts = False
    Workbooks("d.xls").Save
    Workbooks("d.xls").Close
    Application.DisplayAlerts = True
    Workbooks("c.xls").Close

    Application.Quit
End Sub

これでブックをオープンしたときに実行されます。

ただ、マクロのセキュリティが中以上だとマクロを有効にしますか？の画面は出てしまいます。

それでセキュリティを低にすれば表示されなくなりますが、マクロが動くと終了してしまうので編集ができません。

その場合は、別のExcelのファイルを開いてセキュリティを変更してください。

id:ohtsu6

どうもありがとうございます。

無事にできました。

2008/11/12 22:54:22
id:Mook No.3

回答回数1314ベストアンサー獲得回数393ここでベストアンサー

ポイント100pt

EXCEL を使用しなくてもできそうですが、とりあえずEXCELを使用した実装です。

ThisWorkbook の下に保存して実行ください。


補足はコメントで行いますので、有効にお願いいたします。

Private Sub Workbook_Open()
'--- ファイル名の定義
    Const SRC_FILE_B = "C:\b.xls"
    Const SRC_FILE_C = "C:\c.xls"
    Const SRC_FILE_D = "C:\d.xls"
'--- シート名の定義
    Const SRC_SHEET = "0811"
    

'1.
'「C:\」に保存してある「b.xls」のバックアップを
'「C:\back」に「b_作業当日の日付.xls」という名前で保存したい
    Dim dstFile As String
    dstFile = "C:\back\b_" & Format(Date, "YYYYMMDD") & ".xls"
    If Dir(dstFile, vbNormal) <> "" Then
        MsgBox "[" & dstFile & "]は既に存在しています。"
        Exit Sub
    End If
    FileCopy SRC_FILE_B, dstFile

'2.
'「C:\」に保存してある「c.xls」のシート「0811」を
'「C:\data」に保存してある「d.xls」にコピーしたい

    If Dir(SRC_FILE_C, vbNormal) = "" Then
        MsgBox "[" & SRC_FILE_C & "]はありません。"
        Exit Sub
    End If
    
    If Dir(SRC_FILE_D, vbNormal) = "" Then
        MsgBox "[" & SRC_FILE_D & "]はありません。"
        Exit Sub
    End If

    Dim srcWB As Workbook
    Set srcWB = Workbook.Open(SRC_FILE_C)
    
    Dim dstWB As Workbook
    Set dstWB = Workbook.Open(SRC_FILE_D)

    
    srcWB.Worksheets(SRC_SHEET).Copy after:=dstWB.Worksheets(dstWB.Worksheets.Count)
    
    dstWB.Save
    dstWB.Close
    
    Application.DisplayAlerts = False
    srcWB.Close

'--- 終了メッセージ：不要なら次行を削除
    MsgBox "処理を終了しました。"

'3.
'終了後エクセルを終了させたいです｡
    ThisWorkbook.Saved = True
    ThisWorkbook.Close False

    ' 他にブックが開いていなければ、Excelを終了する
    If Workbooks.Count <= 1 Then
        Application.Quit
    End If
End Sub

http://officetanaka.net/excel/vba/statement/FileCopy.htm

http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_800_060.html

id:ohtsu6

どうもありがとうございます。

ファイル名やシート名がたまに変わることがあるので、

定義はとても便利そうです。

Set srcWB = Workbook.Open(SRC_FILE_C)

でエラーになってしまいましたが、

Set srcWB = Workbooks.Open(SRC_FILE_C)

とすることで実行することができるようになりました。

2008/11/12 23:02:29

コメント（1件)

  • id:Mook
    Mook 2008/11/12 23:07:29
    多くのポイントといるか賞ありがとうございます。

    コードに問題があったようですみません。
    ご自身で解決できたようでなによりでした。

この質問への反応（ブックマークコメント）

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

回答リクエストを送信したユーザーはいません
ユーザー登録をして使いはじめる!無料
すでに登録されている方はこちらからログイン
この質問に含まれるキーワード
知りたいことを検索してみよう
▲ページトップへ