Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9366 / 76732 ←次へ | 前へ→

【72928】フォルダ移動
質問  バッファー  - 12/10/13(土) 9:36 -

引用なし
パスワード
   フォルダ移動マクロを作成していますが、移動ができず原因が
把握できなくなりました。どのようにすれば達成できますでしょうか?
お知恵を拝借頂ければ幸いです。


目的:
一覧表シートのF11行以降にハイパーリンクが設定されており、
ハイパーリンク先には幾つかフォルダがあります。
指定したフォルダだけを移動したい。(指定したフォルダ名は記録廃棄結果のJ14に指定されている)
移動先は記録廃棄結果J10のハイパーリンク先に移動させる。
なお、移動後に指定したフォルダには連番(数字)を語尾に付けたい。

質問の不備がございましたらご一報をお願いします。


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 = "3年"

  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 = ""
    '一覧表H列に3年と記入あるものだけ
    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

0 hits

【72928】フォルダ移動 バッファー 12/10/13(土) 9:36 質問
【72934】Re:フォルダ移動 ウッシ 12/10/13(土) 12:10 回答
【72936】Re:フォルダ移動 バッファー 12/10/13(土) 16:55 発言
【72937】Re:フォルダ移動 ウッシ 12/10/14(日) 0:45 回答
【72945】Re:フォルダ移動 バッファー 12/10/15(月) 7:46 発言
【72946】Re:フォルダ移動 ウッシ 12/10/15(月) 9:41 回答
【72955】Re:フォルダ移動 バッファー 12/10/16(火) 19:11 お礼
【73042】Re:フォルダ移動 バッファー 12/10/30(火) 21:30 発言
【73043】Re:フォルダ移動 ウッシ 12/10/30(火) 23:40 回答
【73044】Re:フォルダ移動 バッファー 12/10/31(水) 21:08 お礼

9366 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free