Word VBA質問箱 IV

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

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


291 / 308 ツリー ←次へ | 前へ→

【76】コードのバックアップ こるぎ 04/1/23(金) 9:53 質問[未読]
【77】Re:コードのバックアップ ichinose 04/1/31(土) 9:35 回答[未読]
【78】Re:コードのバックアップ こるぎ 04/1/31(土) 11:41 お礼[未読]
【79】Re:コードのバックアップ ichinose 04/1/31(土) 20:05 発言[未読]
【80】Re:コードのバックアップ こるぎ 04/2/2(月) 15:15 お礼[未読]
【81】Re:コードのバックアップ ichinose 04/2/2(月) 17:21 回答[未読]
【82】Re:コードのバックアップ こるぎ 04/2/3(火) 11:38 お礼[未読]

【76】コードのバックアップ
質問  こるぎ  - 04/1/23(金) 9:53 -

引用なし
パスワード
   お尋ねします。
PCクラッシュ等に備えて、皆さんは、コードのバックアップはどうされて
いるのでしょうか?

私は、コードを書き換えるために、エクスポートして、そのファイルを
外付けHDD等に定期的に保存していますが、時々、エクスポート自体を忘れています。
もし、その間にPCがクラッシュしたら・・・と不安です。

そこで、コードが格納されているフォルダが分かれば教えていただけないでしょうか。
そのフォルダごと定期的にバックアップすれば安全ですので。

よろしくお願い致します。

【77】Re:コードのバックアップ
回答  ichinose  - 04/1/31(土) 9:35 -

引用なし
パスワード
   ▼こるぎ さん:
おはようございます。ichinoseと申します。
普段、WORD VBAの掲示板は、あまり閲覧していないのですが、気になる内容だったので
投稿しました。
時間が経ってしまったので、ご覧になってもらえないかもしれませんが・・。
>私は、コードを書き換えるために、エクスポートして、そのファイルを
>外付けHDD等に定期的に保存していますが、時々、エクスポート自体を忘れています。
>もし、その間にPCがクラッシュしたら・・・と不安です。
>そこで、コードが格納されているフォルダが分かれば教えていただけないでしょうか。
>そのフォルダごと定期的にバックアップすれば安全ですので。
以下に示すコードの仕様です。

機能: 

指定されたフォルダ内にあるWordのDocファイルに含まれるモジュールを指定された
フォルダ内にエクスポートします。
エクスポートファイルは、指定されたフォルダ内に
Docファイル名(拡張子なし)+"exp"という名前のフォルダを
作成し、その中に作成します。
2度、フォルダ選択ダイアログが表示されます。
最初にエクスポート対象のWordDocumentファイルが入っているフォルダ選択
次がエクスポート先フォルダ選択です。

では、コードです。Thisdocumentのモジュールに
'==================================================================
Sub Document_Open()
  Dim r_fld
  Dim w_fld
  Application.ActiveWindow.WindowState = wdWindowStateMinimize
  AppActivate Application.Caption
  r_fld = get_folder_path("一括エクスポートするWordドキュメントの存在するフォルダを選択して下さい")
  If VarType(r_fld) <> vbBoolean Then
   w_fld = get_folder_path("エクスポート先フォルダを選択して下さい")
   If VarType(w_fld) <> vbBoolean Then
     ans = MsgBox("「" & r_fld & "」に存在するワードファイルのVBAコードを「" & w_fld & "」内に作成します。" & vbLf _
       & "  ・ワードファイル名と同じ名前に「exp」が付いたフォルダが「" & w_fld & "」内に作成されます。" & vbLf _
       & "  ・このフォルダにエクスポートファイルとログファイルが作成されます", vbOKCancel)
     If ans = 1 Then
      WordBasic.DisableAutoMacros 1
      Call export_proc(r_fld, w_fld)
      WordBasic.DisableAutoMacros 0
      End If
     End If
   End If
  Application.ActiveWindow.WindowState = wdWindowStateMaximize
 
End Sub
'==================================================================
Sub export_proc(infld, outfld)
  Dim docnm
  Dim ex_doc As Document
  Dim result
  docnm = Dir(infld & "\*.doc")
  Do While docnm <> ""
   If UCase(infld & "\" & docnm) <> UCase(ThisDocument.FullName) Then
     Set ex_doc = doc_open(infld & "\" & docnm)
     If Not ex_doc Is Nothing Then
      result = export_comp(ex_doc, outfld & "\" & Mid(ex_doc.Name, 1, Len(ex_doc.Name) - 4) & "exp")
      If VarType(result) <> vbBoolean Then
        Call mk_log(outfld & "\" & Mid(ex_doc.Name, 1, Len(ex_doc.Name) - 4) & "exp", ex_doc, result)
        End If
      Call doc_close(ex_doc)
      DoEvents
      End If
     End If
   docnm = Dir()
   Loop
End Sub
'==================================================================
Sub mk_log(foldnm, ex_doc As Document, log_mes)
  If open_txt(foldnm & "\" & Mid(ex_doc.Name, 1, Len(ex_doc.Name) - 4) & ".txt") = 0 Then
   Call put_txt("エクスポート対象ワードファイル : " & ex_doc.FullName)
   For idx = LBound(log_mes) To UBound(log_mes)
     Call put_txt(log_mes(idx))
     Next idx
   Call close_txt
   End If
End Sub


'次に標準モジュール(Module1)
'==============================================================
Function doc_open(flnm) As Document
'ドキュメントを開く
'input   : flnm   ----  オープンするファイルのフルパス
'output   : doc_open -----  Documentオブジェクト
  On Error Resume Next
  Set doc_open = Nothing
  Set doc_open = Documents.Open(flnm)
  On Error GoTo 0
End Function
'==============================================================

Sub doc_close(doc As Document)
'ドキュメントのクローズ
  On Error Resume Next
  doc.Close savechanges:=False
  On Error GoTo 0
End Sub
'==============================================================
Function mk_folder(foldernm) As Long
'フォルダの作成
  On Error Resume Next
  mk_folder = 0
  MkDir foldernm
  mk_folder = Err.Number
  On Error GoTo 0
End Function
'==============================================================

Function get_folder_path(mes)
'フォルダ選択処理
'input   :  mes  : 表示メッセージ
  Dim fld
  Set fld = CreateObject("Shell.Application").BrowseForFolder(0, mes, 2, 17)
  On Error Resume Next
  If Not fld Is Nothing Then
    get_folder_path = fld.items.Item.Path
    If Err.Number <> 0 Then
     get_folder_path = False
     End If
  Else
    get_folder_path = False
    End If
  Set fld = Nothing
End Function
'==============================================================
Function export_comp(docu, foldnm)
'指定されたドキュメントのモジュールをエクスポートする
'input : docu     : モジュールをエクスポートするDocumentオブジェクト
'    foldnm    : エクスポートするフォルダ名
'output: export_comp : エクスポートのログメッセージ
'            メッセージがないときは、Falseを返す
  Dim stt_flg As Boolean
  Dim tp As Long
  Dim comp As Object
  Dim exe As Boolean
  Dim log_mes()
  Dim retcode As Long
  export_comp = False
  idx = 1
  On Error Resume Next
  With docu.VBProject
    stt_flg = True
    For Each comp In .VBComponents
     exe = True
     tp = comp.Type
     If tp = 100 Then tp = 4
     If tp = 4 Then
      If comp.CodeModule.CountOfLines <= 0 Then
        exe = False
        End If
      End If
     Err.Clear
     If exe = True Then
      If stt_flg = True Then
        retcode = mk_folder(foldnm)
        If retcode = 0 Or retcode = 75 Then
         stt_flg = False
        Else
         Exit For
         End If
        End If
      comp.Export foldnm & "\" & comp.Name & Choose(tp, ".bas", ".cls", ".frm", ".cls")
      If Err.Number <> 0 Then
        mes = comp.Name & ":" & Error(Err.Number)
      Else
        mes = comp.Name & "エクスポート完了"
        End If
      ReDim Preserve log_mes(1 To idx)
      log_mes(idx) = mes
      idx = idx + 1
      End If
     Next
    End With
  If idx > 1 Then
    export_comp = log_mes()
    End If
  On Error GoTo 0
End Function


'標準モジュール(Module2)に
'==============================================================
Private fno As Long
'==============================================================
Function open_txt(flnm) As Long
  On Error Resume Next
  open_txt = 0
  fno = FreeFile()
  Open flnm For Output As #fno
  open_txt = Err.Number
  On Error GoTo 0
End Function
'==============================================================
Function put_txt(txt) As Long
  On Error Resume Next
  put_txt = 0
  Print #fno, txt
  put_txt = Err.Number
  On Error GoTo 0
End Function
'==============================================================
Function close_txt()
  On Error Resume Next
  Close #fno
  On Error GoTo 0
End Function

以上です。自動実行するようになっています。
よかったら、確認してみて下さい。

【78】Re:コードのバックアップ
お礼  こるぎ  - 04/1/31(土) 11:41 -

引用なし
パスワード
   有り難うございました。

実は、幾通りか試したところ、どうやっても教えていただいたコードのみが書き出されてしまいました。
私はまだVBA初心者なもので、やり方が間違っているからと思いますが、教えていただいたコードを時間をかけてゆっくり勉強し、いずれ実用化に向けて頑張ってみたいと思います。

【79】Re:コードのバックアップ
発言  ichinose  - 04/1/31(土) 20:05 -

引用なし
パスワード
   ▼こるぎ さん:
こんばんは。
まず、投稿したコードは、Word2000で動作確認を行いました。

Word2002以降では、セキュリティでの設定が必要です。
「ツール」---「マクロ」----「セキュリティ」で、
”信頼のおける発行元”のVisualBasicプロジェクトへのアクセスへの信頼する
にチェックして下さい。


>実は、幾通りか試したところ、どうやっても教えていただいたコードのみが書き出されてしまいました。
詳しく教えていただければ、こちらでも検証しますが、
正常に作動すれば、コードがあるDocファイルのエクスポートは行いません・・・。

それから、以下の変更を行って再試行してみてください。

>'==================================================================
>Sub Document_Open()
>  Dim r_fld
>  Dim w_fld
'  Application.ActiveWindow.WindowState = wdWindowStateMinimize
↑これ削除してください
>  AppActivate Application.Caption
>  r_fld = get_folder_path("一括エクスポートするWordドキュメントの存在するフォルダを選択して下さい")
>  If VarType(r_fld) <> vbBoolean Then
>   w_fld = get_folder_path("エクスポート先フォルダを選択して下さい")
>   If VarType(w_fld) <> vbBoolean Then
>     ans = MsgBox("「" & r_fld & "」に存在するワードファイルのVBAコードを「" & w_fld & "」内に作成します。" & vbLf _
>       & "  ・ワードファイル名と同じ名前に「exp」が付いたフォルダが「" & w_fld & "」内に作成されます。" & vbLf _
>       & "  ・このフォルダにエクスポートファイルとログファイルが作成されます", vbOKCancel)
>     If ans = 1 Then
>      WordBasic.DisableAutoMacros 1
>      Call export_proc(r_fld, w_fld)
>      WordBasic.DisableAutoMacros 0
>      End If
>     End If
>   End If
'  Application.ActiveWindow.WindowState = wdWindowStateMaximize
 ↑これも削除
>End Sub


>'==============================================================

>Function get_folder_path(mes)
>'フォルダ選択処理
>'input   :  mes  : 表示メッセージ
>  Dim fld
  Set fld = CreateObject("Shell.Application").BrowseForFolder(0, mes, 1, 17)
'                                     ↑
'                                  2→1に変更
'                                   
>  On Error Resume Next
>  If Not fld Is Nothing Then
>    get_folder_path = fld.items.Item.Path
>    If Err.Number <> 0 Then
>     get_folder_path = False
>     End If
>  Else
>    get_folder_path = False
>    End If
>  Set fld = Nothing
>End Function

上記を変更してください

【80】Re:コードのバックアップ
お礼  こるぎ  - 04/2/2(月) 15:15 -

引用なし
パスワード
   ご面倒をおかけして申し訳ありません。
実は、私がやりたかったのは、教えていただいた様な難しいことではなく、もっとはるかに簡単なケースでした。説明が下手で申し訳ありませんでした。

私が行おうとしていたのは、WORD2000にて、

[Normal]-[フォーム]-[****1]
[Normal]-[フォーム]-[****2]
[Normal]-[標準モジュール]-[****1]
[Normal]-[標準モジュール]-[****2] ,****3,****4,・・・  

のみにコードがあり、それぞれのWordファイルにはマクロは記述されておらず、
標準モジュールから、すべてのWordファイルに対し作業を行う。
というシンプルな形になっています。

2回目のご説明で、「それぞれのWordファイルが有するマクロを個別にエクスポートする」と受け取られていたことが分かりましたので(本当に説明不足で申し訳ありませんでした)、それぞれのファイルに適当なマクロを付けて作動させるとその通りに動くことが確認できました。

教えていただいたことは、別のマクロをこれから作成するにあたり、非常に勉強になる部分がたくさんありましたので、無駄にはいたしません。有り難うございました。

私が本来やろうとしていたことは、教えていただいたことを参考に、もうちょっと自分で頑張ってみようと思います。

【81】Re:コードのバックアップ
回答  ichinose  - 04/2/2(月) 17:21 -

引用なし
パスワード
   ▼こるぎ さん:
こんばんは。

>ご面倒をおかけして申し訳ありません。
>実は、私がやりたかったのは、教えていただいた様な難しいことではなく、もっとはるかに簡単なケースでした。説明が下手で申し訳ありませんでした。
>
>私が行おうとしていたのは、WORD2000にて、
>
>[Normal]-[フォーム]-[****1]
>[Normal]-[フォーム]-[****2]
>[Normal]-[標準モジュール]-[****1]
>[Normal]-[標準モジュール]-[****2] ,****3,****4,・・・  

なるほど、それでNormal.dotの保存場所が知りたかったというわけですね!!

上記のNormalの標準モジュールに
'================================
Sub test()
  MsgBox ThisDocument.FullName
End Sub

と記述して実行して下さい。パスが表示されます。
既定のパスは、
「C:\WINDOWS\Application Data\Microsoft\Templates\Normal.dot」
になっているはずですが・・・。

【82】Re:コードのバックアップ
お礼  こるぎ  - 04/2/3(火) 11:38 -

引用なし
パスワード
   本当に有り難うございました。
やっと理解できました。

「Normal.dot」そのものをコピーすればいいという、本当に単純なことだったんですね。
また、このファイル名の「Normal」が、
  [Normal]-[フォーム]-[****1]
の「Normal」のことだと言うことも、今更変わりました。
最近まで一太郎を触ってきた私は、テンプレートを元にWordファイルを作成し、それぞれの中に別々のマクロが入ると言うことを、きちんと理解していませんでした。
そういったところも含めて、今まで理解していなかったことが、すっきりしました。

291 / 308 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
207140
(SS)C-BOARD v3.8 is Free