| |
▼UO3 さん：
>▼ピッポ さん：
>
>こんにちは
>
>質問の中にはいくつものポイントがありますね。
>このなかの、どこまでできて、どこがわからないというレベルですか？
>それとも、全くわあらないのでコードを教えてということですか？
>
>１．シート１のＢ列からループで、Ｅ列に"1ヶ月"と記述されレいる行のブック名を取り出す
>２．取り出したブック名がＣ列のハイパーリンクの規定の中にあるかどうかを判定する
>３．それに対応するシート２のハイパーリンク先を取得する。
> （この対応条件が、いまいち不明ですが。同じ行？あるいは、同じブック名をもつリンクを捜す？）
>４．フォルダ間でブックの移動を行う。
ご回答ありがとうございます。
表現が曖昧で失礼しました。
下記のコードをベースに作成を試みてみたのですが、
全くわからない為、教えて頂けないでしょうか？
3.について補足します。
シート１（ワークシート）とシート２は同じブック内にあり、
シート２に移動する前のファイル先が記載されています。
シート１に移動する後のファイル先が記載されています。
それと下記コードは移動するファイルを開いた時にセルA500に”済”と
記載してあれば、シート１のI列に"問題なし"もし、なければ
"問題あり”とできるようになっています。
こちらのコードも生かして頂きたいのですが。
Sub 転送()
Application.ScreenUpdating = False
'ファイル移動(transfer)
Dim ObjFs_tr As Object
Dim FldN_tr As String
Dim FldN_tr2 As String
Dim FileN_tr As String
Dim Cnt_tr As Integer
Dim Re_tr As Integer
Dim ans As String
Set ObjFs_tr = CreateObject("Scripting.FileSystemObject")
FldN_tr = "C:\記録\"
FldN_tr2 = "\\Svr\記録\保管\"
ans = "済"
With Range("B7") ' <-- File_Name指定セル
If .Text = vbNullString Then
MsgBox "記録名を確認してください。", vbCritical
Else
FileN_tr = Dir(FldN_tr2 & .Text & "*.xls")
Do Until FileN_tr = vbNullString
Workbooks.Open FldN_tr2 & FileN_tr
Worksheets(1).Select
If Range("A500") = ans Then
ActiveWorkbook.Close
.Offset(0, 7).Value = "問題なし"
If ObjFs_tr.FileExists(FldN_tr2 & FileN_tr) Then
ObjFs_tr.MoveFile FldN_tr2 & FileN_tr, FldN_tr
Cnt_tr = Cnt_tr + 1
End If
Else
ActiveWorkbook.Close
.Offset(0, 7).Value = "問題有り"
End If
FileN_tr = Dir()
Loop
End If
End With
MsgBox Cnt_tr & " 個のファイルを「Svr→書庫」に移動しました。", vbInformation
Set ObjFs_tr = Nothing
|
|
ピッポ
- 11/11/12(土) 18:18 -
