|
音速ブルー さん、こんにちわ。
>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
こんな感じです。
|
|