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

質問

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

26行目以下のC列とD列に，ハイパーリンクの貼ってある文書があります。（文字列の文書名にURLが貼ってあるもの）
(1)B25でオートフィルタを実施。
(2)指定された保存場所（D10セル値取得）にファイル名を少し変更（　_を付加しC3セル値取得）して，各文書を保存。
*******************************************************************************
ここまでの内容を前回こちらに初めて投稿し，ご教示いただいて動作するようになりました。（前回投稿；http://okwave.jp/qa/q6003799.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://okwave.jp/qa/q6003799.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

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.1

end-u · ベストアンサー

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

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 様

こんにちは。
先日は，大変御世話になりました。（有難うございました。）
今回も，ご回答をいただきまして有難うございます。
（御連絡が今日になり，申し訳ありません。）

ご回答内容で1)～3)は理解していましたので置換え動作はできました。
だだ，一番始めの変更後のURLが全ての行のURL変更になってしまって困っていました。↓そのコードです。（これでは当たり前の結果ですが。）

>For Each H In Rng.Hyperlinks　でHyperlinkをLoopして処理してますから
>H　がそのHyperlinkです。
>この.AddressプロパティとH.Rangeの.Valueプロパティを変更すれば良いです。
この部分をどう指定したら良いのかわからずにいました。

H.Address=BookName

で動作できました。有難うございました。

本題から少し離れてしまいますが，1つお聞きしても良いでしょうか？
こちらのファイル，URLの文書を開いて保存となっているせいか，
画面制御していても左上に「保存中にでるメッセージが瞬間で出ます」←文字は読み取れないほど速く動作しています。
これを無くすには，「文書を開かなくても保存」にすればいいのかな？と安易に考えていますが，できるものでしょうか？

回答No.4

end-u

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
：

お礼

ご回答と解説文を有難うございました。
理解できました。

今回いただいた内容と前回のコードを参考に
URLDownloadToFile関数との絡みも含めて
後半部分，試行錯誤してみます。（基礎学習の継続優先に・・・）

前回「URLDownloadToFile関数」をとりあえず忘れてくださいと
おっしゃった意味が分かります。

この度も大変御世話になりました。
本当に本当に有難うございました。m(_　_)m

回答No.3

end-u

サンプルコードです。該当シートで
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

お礼

こんにちは。
本スレッド外の質問になってしまったのにも関わらず，
ご回答をいただきまして有難うございました。（サンプルコード，有難うございます。）

本日，午前中に色々と試してみました。
「URLDownloadToFile関数」は宣言部分からひっかかってしまったのでもう少し時間をかけて取組んでいきたいと思います。
余談4)は，はじめて知りました。（有難うございます。）便利ですね。これも「基礎」なんですよね。（・・・お恥ずかしい。）

今回のサンプルコードと前回スレッドのご回答いただいたコードを参考に
>If UCase(Right$(hLink, 3)) = "XLS" Then
の上記部分までの動きを確認し，1箇所変更しました。
この1箇所の変更について補足欄に記載しました。
間違っていないかみていただきたいのですが・・・。御手隙の時がございましたら，どうぞ宜しくお願い致します。

補足

こんには。サンプルコードから・・・

該当シートの中にHyperlink設定されたセル（列）がＣ，Ｄ列以外にもあるため，
前回スレッドでいただいた内容を利用して

With Sheets("TEST")
'AutoFilterModeでなければ抜ける
If Not .AutoFilterMode Then Exit Sub
'B25FilterModeでなければ抜ける
If Not .FilterMode Then
MsgBox "B25のオートフィルタボタンを実行してください"
Exit Sub
End If
'とりあえずAutoFilter.RangeのC:D列をセット
Set Rng = Intersect(.AutoFilter.Range.EntireRow, .Columns("C:D"))
'hLink = Selection.Hyperlinks(1).Address　←ここの部分かえました。
hLink = Rng.Address　←変更後
'MsgBox "確認用" & vbLf & hLink←B25:C301と指定して出てくれました。
BookUrl = .Range("D10").Value
n = "_" & .Range("C3").Value
End With
'rngの可視セル（抽出セル）をセット
Set Rng = Intersect(Rng, Rng.Offset(1), Rng.SpecialCells(xlCellTypeVisible))
'抽出なければ抜ける
If Rng Is Nothing Then Exit Sub

としました。

VBE[F8]キーでのステップ実行で
>If UCase(Right$(hLink, 3)) = "XLS" Then
以降は，
MsgBox "確認用" & vbLf & xName
や
　MsgBox "結果" & vbLf & hLink & vbLf & BookName
は表示されずに 「End If」　までカーソルが移動されました。
そのため，心配になったのは上記の一行分変更したためにメッセージの表示がされなくなったのかな？ということです。
URLDownloadToFile関数との絡みもあるので他の問題は試行錯誤してみます。
上記の件のみご回答いただけたら助かります。どうぞ宜しくお願い致します。

回答No.2

end-u

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

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

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

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

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

お礼

End-_u 様

ご回答を有難うございました。（具体的な関数を教えていただけて助かります。）
画面の「左上に保存中にでるメッセージが瞬間で出る」のは，使用者側からみて，気になるところなので提出期限までに何れ解消したいと思っていますが，現在の私の力ではできないので基礎の勉強をこのまま進めたいと思います。

>時には妥協も必要です。
私も妥協したいのですが，立場上できないのです。（なので，こちらに投稿してご回答をいただけるのはとても助かっています。（最後の砦となっているので。）
5月からVBAを学びはじめた状態なので，本当にこの数ヶ月つらかったです。
今はEnd_u様のご回答を参考に，コードの解読や学び方を進めていけるので気持ち的に少し楽になりました。ファイルの方も思ったように動くことで楽しさも感じることができました。きちんと書ければ，便利で楽しいものなのだな，と。
（ただ，1文字でも間違うとエラーが出るので「奥が深過ぎる」と日々感じていますが。）

「ファイルを開いて保存」はしたかった動作ではありませんでした。
ただ，WEB上から見つけて「使える」と思い，設定したのです。「メンテナンス面を考える」。今なら理解できます。

もしお手数でなければ，コードではなく，
「RLDownloadToFile関数を使う場合」のキーワードでまだ必要なもの（関数など）がありましたら，教えて頂けないでしょうか？

>・HyperlinkのAddressに設定されたファイルのフルパスを取得。
出来そうかここが微妙です。
>・フルパスからxlsBook名だけを抜き出す。
なんとかなりそうです。前回のスレッド回答を参考にして。
>・Book名に保存先フォルダ文字列を結合して、ダウンロード元AddressとともにURLDownloadToFile　関数の引数として渡す。
D10の値＋Book名をしてから，ダウンロード元Addressが固定ではないので「区切り文字"/"に着目して前の部分を抜取る」で考え方は合っていますでしょうか？

お礼欄ですのに，ご質問をして申し訳ありません。
学ぶ範囲が広いため，関数などは，できれば必要なものから手をつけて行きたいと思いました。どうぞ宜しくお願い致します。