[[20221012140345]]　『エラー 52「ファイル名または番号が不正です。」』（わたなべ）　ページの最後に飛ぶ

『エラー 52「ファイル名または番号が不正です。」』（わたなべ）

下記コードのマクロで「ァイル名または番号が不正です。」とエラーになり、エラー箇所は「A = Dir(ThisWorkbook.Path & "\1012コピー\*")」です。
解決するにはどのような変更が必要か教えてください。

Sub シートコピー()

   Dim FolderName As String '文字列を入れる変数として「FolderName」を使う
   Dim FileName As String '文字列を入れる変数として「FileName」を使う
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            FolderName = .SelectedItems(1) & "\"
            Else
            Exit Sub
        End If
    End With
  Dim A
  'フォルダ内のブック名を取得
  A = Dir(ThisWorkbook.Path & "\1012コピー\*")
  Do While A <> ""
    'ブックを開く
    Workbooks.Open ThisWorkbook.Path & "\1012コピー" & A
    With ActiveWorkbook
      'シートをコピーして取得
      .Worksheets("Sheet4").Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
      'シート名をブック名に変更
      ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = Left(.Name, 10)     
      .Close False 'ブックを閉じる
    End With
    A = Dir() '次のブック名を取得
  Loop  
End Sub

＜使用 Excel：Office365、使用 OS：Windows10 ＞

1012コピー
フォルダが無いのでは。。。多分。。。＾＾；

（隠居Z） 2022/10/12(水) 14:38:49

↑もちろん、マクロブックが有るパスの階層に
です。m(__)m
わたし、よく二重指定で、ミスルもので。つい。。。＾＾；
m(__)m
（隠居Z） 2022/10/12(水) 14:54:30

＞エラー箇所は「A = Dir(ThisWorkbook.Path & "\1012コピー\*")」です。
そこじゃなくて、次でエラーになってませんか？

 誤　Workbooks.Open ThisWorkbook.Path & "\1012コピー" & A
 正　Workbooks.Open ThisWorkbook.Path & "\1012コピー\" & A

↑なんじゃないかと。

あと、好みの問題ではありますが以下のようにするとすっきりするかと思います。

 With ActiveWorkbook
　　↓
 With Workbooks.Open(ThisWorkbook.Path & "\1012コピー\" & A)

（もこな２） 2022/10/12(水) 15:10:23

マクロブックが有るパスの階層にフォルダ名1012コピーはあります。
「Workbooks.Open ThisWorkbook.Path & "\1012コピー\" & A」と「 With Workbooks.Open(ThisWorkbook.Path & "\1012コピー\" & A)」へ修正ましたが、
同一エラ箇所で「A = Dir(ThisWorkbook.Path & "\1012コピー\*")」で止まります。
以前は動いていたのですが…
（わたなべ） 2022/10/12(水) 15:47:41

マクロ下記に変更してみましたが同一エラーで、エラー箇所は「Filename = Dir(ThisWorkbook.Path & "\利用状況表COPY\*.xlsx")」になります。フォルダ内に.xlsxファイルはあるのですが？

Sub シートコピー2()
Dim Filename As String
Dim IsBookOpen As Boolean
Dim OpenBook As Workbook
Dim ShCount As Long
Dim fullName As String

    Filename = Dir(ThisWorkbook.Path & "\1012コピー\*.xlsx")
    Do While Filename <> ""
      If Filename <> ThisWorkbook.Name Then
          IsBookOpen = False
          For Each OpenBook In Workbooks        
      If OpenBook.Name = Filename Then
          IsBookOpen = True
          Exit For
       End If
       Next      
      If IsBookOpen = False Then
         ShCount = ThisWorkbook.Worksheets.Count
         fullName = ThisWorkbook.Path & "\1012コピー\" & "\" & Filename
         Workbooks.Open fullName, UpdateLinks:=1        
         Worksheets("Sheet4").Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)       
         Workbooks(Filename).Close SaveChanges:=False       
       End If
      End If
      Filename = Dir()
   Loop
End Sub」
（わたなべ） 2022/10/12(水) 16:01:59

こんばんわ。
当方で、最初、1～2度、エラーしていましたが。
なので、投稿いたしましたが。そのぉ
今、もこな２さん、ご案内の通りで、再現致しません。
不思議だな～
相違するファイル番号
若しくは
使えない、ファイル名前
の時に出るエラーだそうです。
私の手にはおえそうにありません。
他の回答者様のご案内を、お待ちください。
m(__)m。。。勉強になりますので。原因は調べてみようと思います。
でわ
（隠居Z） 2022/10/12(水) 16:36:43

＞マクロ下記に変更してみましたが同一エラーで、エラー箇所は「Filename = Dir(ThisWorkbook.Path & "\利用状況表COPY\*.xlsx")」になります

コードにはそんなところが無いです。
でたらめ書いてる？
（めっちゃ） 2022/10/12(水) 18:33:41

 Dirで「実行時エラー52」と言えば、
 フォルダ名(ファイル名ではない)にShift-JIS にマッピングされない文字が含まれてると発生する場合がありますね。
 例えば ChrW(9312)はセーフ、ChrW(10112)だとエラー。って経験があります。

（白茶） 2022/10/12(水) 19:39:33

書きためていたら白茶さんから有用な情報がありましたが、とりあえず投稿します。

問題の解決にはつながらないと思いますが何点か。

■１
「シートコピー2」のインデントをちゃんと付け直してみると↓のようになります。

    Sub シートコピー2()
        Dim Filename As String, fullName As String
        Dim IsBookOpen As Boolean
        Dim OpenBook As Workbook
        Dim ShCount As Long

        Filename = Dir(ThisWorkbook.Path & "\1012コピー\*.xlsx")
        Do While Filename <> ""
            If Filename <> ThisWorkbook.Name Then
                IsBookOpen = False
                For Each OpenBook In Workbooks
                    If OpenBook.Name = Filename Then
                        IsBookOpen = True
                        Exit For
                    End If
                Next

                If IsBookOpen = False Then
                    ShCount = ThisWorkbook.Worksheets.Count
                    fullName = ThisWorkbook.Path & "\1012コピー\" & "\" & Filename
                    Workbooks.Open fullName, UpdateLinks:=1
                    Worksheets("Sheet4").Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
                    Workbooks(Filename).Close SaveChanges:=False
                End If
            End If

            Filename = Dir()
        Loop
    End Sub

上記をみて思うのですが、↓は必要ですか？

                For Each OpenBook In Workbooks
                    If OpenBook.Name = Filename Then
                        IsBookOpen = True
                        Exit For
                    End If
                Next

結局、ファイル名が自ブックと同じでなければ処理するということでいいんですよね？

■２
また↓は、開いてアクティブになったブックの「Sheet4」という名前のシートですよね。

                    Worksheets("Sheet4").Copy

■３
上記を踏まえて整理すると↓のようになるとおもうので

    Sub シートコピー2_整理()
        Dim フォルダパス As String, ブック名 As String

        フォルダパス = ThisWorkbook.Path & "\1012コピー\"
        ブック名 = Dir(フォルダパス & "*.xlsx")

        Do While ブック名 <> ""
            Debug.Print ブック名
            Stop

            If ブック名 <> ThisWorkbook.Name Then
                With Workbooks.Open(フォルダパス & ブック名, UpdateLinks:=1)
                    .Worksheets("Sheet4").Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
                    .Close SaveChanges:=False
                End With
            End If

            ブック名 = Dir()
        Loop
    End Sub

【ステップ実行】してみて、思うとおりのファイルがつかめているかチェックしてみてはどうでしょうか？

（もこな２） 2022/10/12(水) 19:58:24

みなさんありがとうございます。
対象のフォルダ「1012コピー」を別のPCで試すため圧縮したところ、エラー「圧縮フォルダで使用できない文字が含まれているためディレクトリの名前を変更してください。」となりました。試しにフォルダを再作成し、必要なファイルを格納し、マクロを実行したところ無事動きました。コードのご提供をいただいたみなさんありがとうございました。
（わたなべ） 2022/10/12(水) 20:36:56

コメント返信：

[ 一覧(最新更新順) ]

[[20221012140345]] 『エラー 52「ファイル名または番号が不正です。」』（わたなべ） ページの最後に飛ぶ

[[20221012140345]]　『エラー 52「ファイル名または番号が不正です。」』（わたなべ）　ページの最後に飛ぶ