私には複雑すぎて困っています_Excel2000VBA

Question

26行目以下のC列とD列に，ハイパーリンクの貼ってある文書があります。（文字列の文書名にURLが貼ってあるもの）
(1)B25でオートフィルタを実施。
(2)指定された保存場所（D10セル値取得）にファイル名を少し変更（　_を付加しC3セル値取得）して，各文書を保存。
*******************************************************************************
ここまでの内容を前回こちらに初めて投稿し，ご教示いただいて動作するようになりました。（前回投稿；http://oshiete.goo.ne.jp/qa/6003799.html）
今回，困っていることですが，
この一連の処理で保存した文書（オートフィルタで選択された文書）のＣ列，Ｄ列のハイパーリンクアドレスの表示を処理後のアドレスに変更したいのです。
処理前：http://ABC/D/EF/GHI/JKL/文書あ.xls
処理後：\aaa\bb\ccc\dd\eee\文書あ_なまえ.xls
処理前の「http://ABC/D/EF/GHI/JKL/」部分は「文書い」や「文書え」のケースなど，文書によってURLが異なっています。（固定ではありません。）
処理後の「\aaa\bb\ccc\dd\eee\」部分はD10セル値，「_なまえ」部分はC3セル値を取得しているので固定ではありません。
調べてみると固定のケースは多くありましたが，今回のようなケースが見つかりませんでした。今回のケースの場合，処理したURLと置換え後のURLを別シートへ書き出し，それを元の場所へ戻す（上書する）みたいなことをしなければならないのでしょうか？
前回ご教示いただいた下記コードを利用しての良い方法があれば・・・と思っています。どうぞ宜しくお願い致します。
Sub try()
　省略。（前回投稿；http://oshiete.goo.ne.jp/qa/6003799.htmlのベストアンサーと同じです。）
UserForm1.Show vbModeless
UserForm1.Repaint
'ここから時間のかかる処理
'Dim Cnt As Long
    '■※1）画面更新停止
    Application.ScreenUpdating = False
    'rng.HyperlinksをLoop
    For Each H In Rng.Hyperlinks
        'Excelファイルの処理
        If UCase(Right$(H.Address, 3)) = "XLS" Then
           H.Follow NewWindow:=False
         With ActiveWorkbook
         BookName = BookUrl & Replace$(.Name, ".xls", n & ".xls", , , vbTextCompare)
                                '■※2）既存ファイルあれば削除しておく
                If Len(Dir(BookName)) > 0 Then Kill BookName
                .SaveAs Filename:=BookName
                .Close

ここに，あるコードを入れて試したところ，動きましたが，指定したコードがシート全体のハイパーリンクを指定したため全て同じURL表示となってしまいました。（あたりまえですが・・・）
「上記の処理の完了した文書のみ」という指定はできるのでしょうか？

End With
        End If
    Next
    Unload UserForm1
    '■※1）画面更新再開
    Application.ScreenUpdating = True
    Set Rng = Nothing
Dim myR2
myR2 = MsgBox("ご指定の場所へ保存しました。ご確認ください。", vbOKOnly, "ファイルの作成の完了")
End Sub

どうぞ宜しくお願い致します。m(_　_)m

end-u · Accepted Answer

落ち着いて考えてみてください。

1)H.Follow NewWindow:=False　でハイパーリンク先を開きます。

2)BookName = BookUrl & Replace$(.Name, ".xls", n & ".xls", , , vbTextCompare)
ここでD10セルとC3セルを使った新しいファイル名の文字列を設定して

3).SaveAs Filename:=BookName
新しいファイル名で保存しています。

つまり変数BookNameが置換え後のファイル.FullNameです。
これをハイパーリンク先に変更すれば良いですね。

For Each H In Rng.Hyperlinks　でHyperlinkをLoopして処理してますから
H　がそのHyperlinkです。
この.AddressプロパティとH.Rangeの.Valueプロパティを変更すれば良いです。

end-u · Answer

前スレッドで
>...とりあえずURLDownloadToFile関数の事は忘れてください。
って書いてますので忘れてもらえたのだとは思いますが、
ファイルを開かなくてもダウンロードはできます。

ただ前回のアドバイスの流れとして意図していたのは、
まず基本を押さえて、それから自分の理解できる範囲で応用・工夫されていけばいいんじゃないか、
という事です。

やりたい事は実現可能でしょうけど、自分のスキルに合わせて使わないと、何かあった時のメンテナンスにも困ります。
まして他のユーザーに提供するわけですから、自分でサポートできるものを提供されたほうが良いと思います。
出来る事からやってください。
時には妥協も必要です。

他にも方法はあるかと思いますが、
URLDownloadToFile関数を使う場合の手順としては、
・HyperlinkのAddressに設定されたファイルのフルパスを取得。
・フルパスからxlsBook名だけを抜き出す。
・Book名に保存先フォルダ文字列を結合して、ダウンロード元AddressとともにURLDownloadToFile関数の引数として渡す。
といった感じです。

抜き出すにはパスの区切り文字"/"に着目して、Split関数とUbound関数、
またはInStrRev関数とMid関数などを使う事になります。
まずはそれらの関数について知るところから始めないといけませんね。
がんばってください。

end-u · Answer

サンプルコードです。該当シートで
Hyperlink設定されたセルを選択して実行。
Sub test()
　　Dim BookUrl　As String
　　Dim BookName As String
　　Dim n　　　　As String
　　Dim hLink　　As String
　　Dim xName　　As String
　　Dim v

If Selection.Hyperlinks.Count = 0 Then Exit Sub
　　hLink = Selection.Hyperlinks(1).Address
　　MsgBox "確認用" & vbLf & hLink
　　
　　With Sheets("sheet1")
　　　　BookUrl = .Range("D10").Value
　　　　n = "_" & .Range("C3").Value
　　End With
　　
　　If UCase(Right$(hLink, 3)) = "XLS" Then
　　　　xName = Mid$(hLink, InStrRev(hLink, "/") + 1)
　　　　'v = Split(hLink, "/")
　　　　'xName = v(UBound(v))
　　　　MsgBox "確認用" & vbLf & xName
　　　　BookName = BookUrl & Replace$( _
　　　　　　xName, ".xls", n & ".xls", , , vbTextCompare)
　　　　MsgBox "結果" & vbLf & hLink & vbLf & BookName
　　End If
End Sub

URLDownloadToFile関数についての参考サイト。
http://www.ken3.org/backno/backno_vba25.html
キャッシュを読み込んでしまう場合、下記の後半箇所を参考にしてください。
http://www.f3.dion.ne.jp/~element/msaccess/AcTipsMSHTML.html
Win32APIのDeleteUrlCacheEntry関数も必要な状況かもしれません。

以下余談。
ことExcelVBAに関しては
1)「新しいマクロの記録」の活用
2)VisualBasicEditor、調べたい語句にマウスキャレットあてて[F1]キーでのHELPクイックアクセス
3)VBE[F8]キーでのステップ実行
4)VBE[Alt][v][s]の[ローカルウィンドウ]で変数調査
5)google検索
あとは「時間」と、労を厭わない「やる気」、があれば大抵の事は自力解決できるはず。
...って思ってます。
いろいろと試行錯誤しながら自分でやってみる事が大事。

それではこのへんで :D

end-u · Answer

Sub testの
　　hLink = Selection.Hyperlinks(1).Address
　　MsgBox "確認用" & vbLf & hLink
ここのhLink、つまりSelection.Hyperlinks(1).Addressでは何が取得できましたか？
ダウンロードしたいxlsファイルのURLアドレスのはずです。

補足コードの
>hLink = Rng.Address　←変更後
>'MsgBox "確認用" & vbLf & hLink←B25:C301と指定して出てくれました。
これは意図したものと違いますよね。
Loop対象範囲のセルアドレスそのものを取得したいわけではなく
Loop対象範囲にあるHyperlink個々に設定されたURLアドレスが必要なわけです。

Sub testはサンプルとして単独セルのHyperlinkについて処理しています。
これをLoop処理内に組み込まないといけません。
Sub tryの
：
　'rng.HyperlinksをLoop
　For Each H In Rng.Hyperlinks
　　'Excelファイルの処理
　　If UCase(Right$(H.Address, 3)) = "XLS" Then
：
ここでLoop処理してます。
Sub testでの Selection.Hyperlinks(1) はこの H に当たります。
だから Selection.Hyperlinks(1).Address は H.Address 。
：
　For Each H In Rng.Hyperlinks
　　hLink = H.Address
　　'MsgBox "確認用" & vbLf & hLink
　　If UCase(Right$(hLink, 3)) = "XLS" Then
：

私には複雑すぎて困っています_Excel2000VBA

落ち着いて考えてみてください。

前スレッドで

サンプルコードです。

この回答への補足

Sub testの

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング