| |
フォルダ移動マクロを作成していますが、移動ができず原因が
把握できなくなりました。どのようにすれば達成できますでしょうか？
お知恵を拝借頂ければ幸いです。
目的：
一覧表シートのＦ１１行以降にハイパーリンクが設定されており、
ハイパーリンク先には幾つかフォルダがあります。
指定したフォルダだけを移動したい。（指定したフォルダ名は記録廃棄結果のＪ14に指定されている）
移動先は記録廃棄結果Ｊ１０のハイパーリンク先に移動させる。
なお、移動後に指定したフォルダには連番（数字）を語尾に付けたい。
質問の不備がございましたらご一報をお願いします。
Sub ボタン1_Click()
Dim myFso As Object
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim c As Range
Dim oFold As String
Dim nFold As String
Dim fName As String
Dim i As Long
Dim mySuffix As String
Dim myCheck As String
Dim myFile As Object
myCheck = "３年"
Set myFso = CreateObject("Scripting.FileSystemObject")
Set sh1 = Sheets("記録廃棄結果")
Set sh2 = Sheets("一覧表")
mySuffix = sh1.Range("J14").Value
For Each c In sh2.Range("B11", sh2.Range("B" & sh2.Rows.Count).End(xlUp))
'myPrefix = c.Value
i = c.Row
fName = ""
'一覧表Ｈ列に３年と記入あるものだけ
If sh2.Cells(i, "H").Value = myCheck Then
'記録廃棄結果にハイパーリンクがあるとき
If sh1.Range("J10").Hyperlinks.Count > 0 Then
oFold = sh1.Range("J10").Hyperlinks(1).Address
'一覧表F列にハイパーリンクがあるとき
If sh2.Cells(i, "F").Hyperlinks.Count > 0 Then
nFold = sh2.Cells(i, "F").Hyperlinks(1).Address
'移動後フォルダ、移動前フォルダが存在するものだけ
If myFso.FolderExists(oFold) And myFso.FolderExists(nFold & "\" & mySuffix) Then
If myFso.fileExists(nFold & "\" & mySuffix) Then myFso.Deletefolder nFold & "\" & mySuffix, Force:=True
myFso.MoveFolder nFold & "\" & mySuffix, oFold
End If
End If
End If
End If
Next
Set myFso = Nothing
Set sh1 = Nothing
Set sh2 = Nothing
End Sub
|
|
バッファー
- 12/10/13(土) 9:36 -
