| 
    
     |  | 音速ブルー さん、こんにちわ。 >Excel2000です。
 >Resultsというフォルダの中に、1stというフォルダと、名簿というエクセルファイルがあります。
 >1stフォルダの中にTotalというエクセルファイルがあり、名簿ファイルのデータがTotalファイルにリンク貼り付けされています。
 
 >Resultsフォルダを、移動させると名簿とTotalのリンクが切れてしまうので、自動的にひとつ上の階層の名簿ファイルを読み込ませようとしたのが、以下のコードです。
 
 >ChDir pt
 >ChDir".."
 >cr = CurDir
 >ActiveWorkbook.ChangeLink Name:=cr & "名簿.xls" ,_
 >Newname:=cr & "名簿.xls" , Type:=xlExcelLinks
 >特に下から2行目の、Resultsフォルダを移動前の名簿ファイルのパスの指定でうまくいっていないようです。
 現在のカレントとマクロの記述をしてあるファイルのドライブが一致していないのかもとか、最後にPathSeparatorがついてないのかもとか原因はいろいろと考えられますが。
 
 フォルダの指定はそのまま使えば大丈夫です。
 リンク名はオブジェクトから取得するようにしましたが、複数のファイルがリンクしているならば、そこでの分岐も必要になります。
 Sub test()
 Dim cr As String, ls As Variant
 With Application
 pt = .ThisWorkbook.Path 'ActiveWorkbookとは別もの?
 ps = .PathSeparator 'だいたいは¥
 End With
 '一つ上のフォルダの名簿.xls
 pt = pt & ps & ".." & ps & "名簿.xls"
 '
 If Dir(pt) = "" Then
 MsgBox "一つ上には該当ファイルなし", vbExclamation
 Else
 With ActiveWorkbook
 ls = .LinkSources(xlExcelLinks)
 If Not IsEmpty(ls) Then
 For i = 1 To UBound(ls)
 .ChangeLink Name:=ls(i), Newname:=pt, Type:=xlExcelLinks
 Next i
 End If
 End With
 End If
 End Sub
 
 こんな感じです。
 
 |  |