Excelのリンクに関して

質問

いつもお世話になっております。

今仕事でＭドライブに入っている基礎データを
Ｇドライブに入っているいくつかのExcelファイルに
リンクをしています。

近日中にそのＭドライブがＨドライブに
移行されることになりました。

必然的にＧファイルのExcelファイルのリンク元も
Ｍドライブ→Ｈドライブに変更しなければなりません。

そこで今考えつくのが
対象のファイル1つ1つを開いて
置換でＭドライブ→Ｈドライブにする方法ですが
かなりの量があり困っています。

なにかもっと簡単にできる方法をご存知の方いらっしゃいましたら教えていただけませんか？

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

回答No.3

KenKen_SP · ベストアンサー

再度こんにちは、KenKen_SP です。

指定フォルダ内のExcelファイルにおいて、一括置換を行うコードです。
検索語や置換語はディフォルトで使えるようにしてありますが、指定
することもできます。

すみませんが、かなり即効でつくったので、動作確認が不十分です。
試す場合は必ずバックアップを取ってからお試し下さい。無保証です。

シートが保護されていたりすると置換に失敗しますので、その際はエラー
ログを出力する仕様にはしましたが、手抜きですので、こちらの処理で
エラーがでるかも。余り大量のファイルを一度に処理しない方がいいと
思います。

標準モジュールに貼り付けて下さい。

余談ですが、数式によるリンク部の置換を対象としていますが、コード
を一箇所直すと値の一括置換ができます。この場合、REPLACE_EX 関数の
第4引数を False にするだけです。

Option Explicit

'// フォルダ内の複数のブックで置換処理
Sub REPLACE_MANY_BOOKS()

　　'※Thisworkbookは対象外となります

　　Dim WB　As Workbook
　　Dim SH　As Worksheet
　　Dim FSO As Object
　　Dim objFOLDER　As Object
　　Dim strERRLOG　As String
　　Dim sBEFORE　　As String
　　Dim sAFTER　　 As String
　　Dim sERRMES　　As String
　　Dim lngCNT　　 As Long
　　Dim strLOGPATH As String
　　Dim strDIR　　 As String
　　Dim strPATH　　As String

　　'検索語指定
　　sBEFORE = InputBox(Prompt:="検索語を入力して下さい", Default:="M:\")
　　If sBEFORE = "" Then Exit Sub
　　'置換語指定
　　sAFTER = InputBox(Prompt:="置換語を入力して下さい", Default:="H:\")
　　If sAFTER = "" Then Exit Sub
　　'フォルダ選択ダイアログ表示
　　Set objFOLDER = CreateObject("Shell.Application"). _
　　　　BrowseForFolder(0, "フォルダを選択してください", 0, vbNullString)
　　If Not objFOLDER Is Nothing Then
　　　　strDIR = objFOLDER.Self.Path
　　　　Set objFOLDER = Nothing
　　Else
　　　　Exit Sub
　　End If
　　'エラーログの場所
　　strLOGPATH = strDIR & "\ERRORLOG.txt"
　　'警告処理
　　lngCNT = MsgBox( _
　　　　　　　　Prompt:="このマクロは一括置換を行い自動で上書きします。" & vbCrLf _
　　　　　　　　　　& "必ずバックアップを取ってから実行して下さい。" _
　　　　　　　　　　& vbCrLf & vbCrLf _
　　　　　　　　　　& "処理対象：" & strDIR & vbCrLf _
　　　　　　　　　　& "処理内容：" & sBEFORE & " --> " & sAFTER, _
　　　　　　　　Buttons:=vbOKCancel + vbDefaultButton2 + vbExclamation, _
　　　　　　　　Title:="実行許可")
　　If lngCNT = vbCancel Then Exit Sub

　　'初期化
　　lngCNT = 0
　　strERRLOG = "/// 以下のファイルで置換に失敗しました ///" & vbCrLf _
　　　　　　　　& vbCrLf & "・フォルダー:=" & strDIR _
　　　　　　　　& vbCrLf & "・検索する語:=" & sBEFORE _
　　　　　　　　& vbCrLf & "・置換する語:=" & sAFTER & vbCrLf & vbCrLf

　　'ファイル検索＆置換処理
　　On Error GoTo TERMINATE
　　With Application
　　　　.ScreenUpdating = False
　　　　.StatusBar = True
　　　　.Cursor = xlWait
　　End With
　　strPATH = Dir(strDIR & "\*.xls") '<------------検索ファイル指定
　　If strPATH = "" Then Exit Sub
　　Do
　　　　strPATH = strDIR & Application.PathSeparator & strPATH
　　　　If strPATH <> ThisWorkbook.FullName Then
　　　　　　Set WB = Workbooks.Open(strPATH)
　　　　　　Application.StatusBar = "TARGET:=" & WB.Name
　　　　　　DoEvents
　　　　　　For Each SH In WB.Worksheets
　　　　　　　　'※REPLACE_EX関数のオプション第4引数にTrueを指定すると
　　　　　　　　'※数式の置換になる
　　　　　　　　If Not REPLACE_EX(SH, sBEFORE, sAFTER, sERRMES, True) Then
　　　　　　　　　　strERRLOG = strERRLOG _
　　　　　　　　　　　　& "---------------------------------------------------------------" _
　　　　　　　　　　　　& vbCrLf & "◆" & WB.Name & "[ " & SH.Name & "]" _
　　　　　　　　　　　　& vbCrLf & "※" & sERRMES & vbCrLf
　　　　　　　　　　lngCNT = lngCNT + 1
　　　　　　　　End If
　　　　　　Next SH
　　　　　　WB.Close SaveChanges:=True
　　　　End If
　　　　strPATH = Dir()
　　Loop Until strPATH = ""
　　Set WB = Nothing

　　'終了処理
　　If lngCNT = 0 Then
　　　　MsgBox "正常終了しました", vbInformation
　　Else
　　　　'ロギング
　　　　MsgBox lngCNT & "件のシートで置換に失敗しました。" & _
　　　　　　　　"エラーログを出力します。", vbExclamation
　　　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　　　With FSO.CreateTextFile(strLOGPATH, True)
　　　　　　.WriteLine (strERRLOG)
　　　　　　.Close
　　　　End With
　　　　Set FSO = Nothing
　　　　'エラーログ表示
　　　　Shell "notepad.exe " & Chr(34) & strLOGPATH & Chr(34), vbNormalFocus
　　End If

TERMINATE:
　　With Application
　　　　.Cursor = xlDefault
　　　　.StatusBar = ""
　　End With

End Sub

'// 置換処理関数
Public Function REPLACE_EX( _
　　ByRef SH As Worksheet, _
　　ByRef sBEFORE As String, _
　　ByRef sAFTER As String, _
　　ByRef sERRMES As String, _
　　Optional ByVal FORMULA_ONLY As Boolean = False) As Boolean

　　Dim rngTARGET As Range

　　On Error GoTo ERROR_HANDLER
　　If FORMULA_ONLY Then
　　　　'SpecialCellsValues Class
　　　　'(xlErrors OR xlLogical OR xlNumbers OR xlTextValues)=23
　　　　Set rngTARGET = SH.Cells.SpecialCells(xlCellTypeFormulas, 23)
　　Else
　　　　Set rngTARGET = SH.UsedRange
　　End If
　　rngTARGET.Replace _
　　　　　　What:=sBEFORE, _
　　　　　　Replacement:=sAFTER, _
　　　　　　LookAt:=xlPart, _
　　　　　　MatchCase:=False
　　REPLACE_EX = True
　　sERRMES = ""
　　Exit Function

ERROR_HANDLER:
　　REPLACE_EX = False
　　sERRMES = Err.Description & vbCrLf
　　Err.Clear

End Function

お礼

ありがとうございます。

すっごい・・・
ところどころしか意味がわかりませんが
早速月曜日に行ってみます。

取り急ぎ御礼を・・・と思いまして・・・＾＾

結果をまた補足させていただきます。

補足

早速使用してみました。

きちんとできました。

わかりやすいように説明もしていただき
ありがとうございました。

回答No.2

KenKen_SP

こんにちは、KenKen_SP です。

移行した理由がHDDの増設とかパーティションを切ったとかですか？

ファイルそのものを M に移すわけにはいかないのですか？

これができれば簡単だろうけど、できない場合は、現状の H が H
というドライブレターである理由が特にないならドライブレターを
割り当て直すのも手ですね。

現在の H ドライブ --＞ ドライブレターを M に戻す
現在の M ドライブ --＞ ドライブレターを適当に空いてるとこに変更

UNIX みたいにシムリンクができれば一発なんですけどね～。

Excel VBA でリンク先を一括置換する方法もありますが、間違って
置換してしまう事故の可能性がありますね。もし希望があれば、
リンクの状況をもう少し詳しく説明して下さい。変換前と変換後の
数式の例とか。

お礼

早々のご回答ありがとうございます。

社内のシステムの関係で
今まであったサーバーにあった
Ｍドライブは完全に削除され
その代わりにサーバー上にＨドライブができる。
といった感じです。

これだとやはり置換が一番なんでしょうか？

簡単に、社内のシステムに触ることなくできる
方法があれば、教えていただけると助かります。

回答No.1

O_cyan

>ＭドライブがＨドライブに移行される
Ｈドライブに移行されたあとには新たなＭドライブが接続されてしまうのでしょうか？
Ｍドライブが使用されないのであればＨドライブのリンク先のフォルダを共有にしてマイネットワークからフォルダをマイコンピュータにドラッグしＭドライブとして接続するのはどうでしょうか。
リンクのフルパスに合うようにフォルダの階層を作れば行けると思いますが・・。
試したことはありませんが行けると思いますけど・・。

お礼

早々のご回答ありがとうございます。

社内のシステムの関係で
Ｍドライブの中味が全てＨドライブになり
Ｍドライブは削除されてしまう。
ということなんです。

この場合だとやはり置換しかないんでしょうか？

参考にさせていただきます。
ありがとうございました。