ここから本文です

こんにちは。 その節は大変おせわになりました。 また別件で、困っておりまして...

kom********さん

2019/8/1109:59:08

こんにちは。
その節は大変おせわになりました。
また別件で、困っておりまして、再度お力を貸して頂けますでしょうか?

内容と致しましては、
たくさんのエクセルファイルがあり、そのエクセル内のマクロコードの編集(置換え)になります。
こちらのマクロは保存場所毎にボタン操作に保存するといった単純な物です。
マクロコード内の保存先をサーバー上のアドレスに変更したいのですが、
方法が見つかりません。いろいろなサイトも見ましたが、全然検索にヒットしませんでした。

やりたい事は・・・

保存先1)C:\Users\user01\Documents\work\abc1
保存先2)C:\Users\user01\Documents\work\abc2
保存先3)C:\Users\user01\Documents\work\abc3

上記のアドレスをまとめて下記のように編集(置換え)をしたいです。

保存先1)\\\work\abc1
保存先2)\\work\abc2
保存先3)\\work\abc3

また、たくさんのエクセルがありますが、マクロがないエクセルもあり、
開いてみないとわからない状態です。
もし、あれば処理といったような処理はできますか?
どうぞよろしくお願い致します。

閲覧数:
124
回答数:
3

違反報告

ベストアンサーに選ばれた回答

webnaveさん

2019/8/1112:01:17

  • 質問者

    kom********さん

    2019/8/1112:16:59

    はい、そういう事になります^^;

    マクロ内に書かれていますアドレスを編集したいのですが、
    よくわからないんです・・・

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

この回答は投票によってベストアンサーに選ばれました!

ベストアンサー以外の回答

1〜2件/2件中

並び替え:回答日時の
新しい順
|古い順

te******さん

2019/8/1201:06:08

Sub Code_Substitution()
Dim Target As Workbook, i As Long, strCo
Dim oVBC As VBComponent
Dim Folder_Path As String, first_path As String
Dim File_Name As String, Extension As String
Dim WSH As Object
'//////////-----拡張子設定
Extension = ".xlsm"
'//////////-----ダイアログでフォルダの指定
Set WSH = CreateObject("WScript.Shell")
first_path = WSH.SpecialFolders("desktop") '初期 Pathをデスクトップにしています。
Set WSH = Nothing
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = first_path
If .Show = True Then
Folder_Path = .SelectedItems(1) & "\"
End If
End With
If Folder_Path = "" Then Exit Sub

File_Name = Dir(Folder_Path & "*" & Extension)

Do While File_Name <> ""
Set Target = Workbooks.Open(Folder_Path & File_Name)
For Each oVBC In Target.VBProject.VBComponents
If oVBC.Type = 1 Then
With Target.VBProject.VBComponents(oVBC.Name).CodeModule
For i = 1 To .CountOfLines
strCo = .Lines(i, 1)
If InStr(strCo, "C:\Users\user01\Documents") > 0 Then
strCo = Replace(strCo, "C:\Users\user01\Documents", "\")
'Debug.Print strCo
'Debug.Print oVBC.Name
.ReplaceLine i, strCo
End If
Next i
End With
End If
Next oVBC
' Target.Save
' Target.Close
File_Name = Dir()
Loop
End Sub

使い方:
VBComponentを使用していますので
VBEの参照設定で
Microsoft Visual Basic for Applications Extensibility 5.3
にチェックを入れてください。
コードは、コピペでOKですが、実行前にコンパイルして確認してください。

対象のファイル群を同じフォルダに入れて
そのフォルダを選択して実行します。

フォルダ内すべての ".xlsm"拡張子を持つファイルを順次開き、
標準モジュールを順に一行ずつ "C:\Users\user01\Documents"で
検索、あれば、"C:\Users\user01\Documents"を”¥”に置き換えます。
' Target.Save
' Target.Close
保存と閉じるは、検証を行うと思いますので取り敢えず、コメントアウト
期待通りの結果ならコメントを外し纏めて実行してください。
'Debug.Print strCo
'Debug.Print oVBC.Name
は、テスト検証時使ったものです。
削除してOKです。

テストは、2~3のマクロ有効ブックのコピーで任意フォルダに入れ
実行してみてください。
モジュール名、モジュール数には影響されません。
不明な点等は、返信してください。
#あくまでこのコードは、ご質問の内容を実現する目的で作成しましたので定数指定している場所の変更は、出来るだけ、自力でお願いします。

私の環境では問題なく動作しましたが、保証するものではなく、自己責任でお願いします。

/////////////--- 追加記事 ---/////////////////

たくさんのエクセルがありますが、マクロがないエクセルもあり、
開いてみないとわからない状態です。

拡張子でフォルダに分けるプログラムも書いたので、掲示します。
コードを読んで、お使いください。
一応検証済みです。

Sub File_move()
Dim desktop_path As String, Folder_Path As String, File_Name As String
Dim Extension As String, Extension1 As String
Dim destination_Path As String, Folders_Name As String
Dim FSO As Object, WSH As Variant, Pos As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
' On Error Resume Next
Extension = ".xlsx"
Extension1 = ".xlsm"
'//////////-----ダイアログでフォルダの指定
Set WSH = CreateObject("WScript.Shell")
desktop_path = WSH.SpecialFolders("desktop") 'ダイアログの初期 Pathをデスクトップにしています。
Set WSH = Nothing
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = desktop_path
If .Show = True Then
Folder_Path = .SelectedItems(1) & "\"
End If
End With
If Folder_Path = "" Then Exit Sub
File_Name = Dir(Folder_Path & "*")
Do While File_Name <> ""
Pos = InStrRev(File_Name, ".")
If Pos > 0 Then
If LCase(Mid(File_Name, Pos)) = Extension Then
destination_Path = desktop_path & "\通常BOOK\"
ElseIf LCase(Mid(File_Name, Pos)) = Extension1 Then
destination_Path = desktop_path & "\マクロBOOK\"
Else
GoTo skp
End If
End If
If FSO.FolderExists(destination_Path) Then
FSO.MoveFile Folder_Path & "\" & File_Name, destination_Path & "\" & File_Name
Else
FSO.CreateFolder destination_Path
FSO.MoveFile Folder_Path & "\" & File_Name, destination_Path & "\" & File_Name
End If
skp:
File_Name = Dir()
Loop
Set FSO = Nothing
Set WSH = Nothing
End Sub

不明な点等は、返信してください。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

Prometheusさん

2019/8/1111:42:16

申し訳ございませんが、私には分かりません。

マクロを表示するプログラムすら存在しないのです。

ムリヤリ、手作業でやるようなことは出来るかも知れませんが、極めて危険です。

想定外のことが起こっても、対処できないのです。

少し、チャレンジはしてみますが、あきらめておいてください。

多分、ムリです(質問者もネットで調べられて、出てこなかったのは、できないからだと思います)。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる