フォルダ内の全ブックのシート名を変更したい

パワークエリでフォルダにある複数ファイルのデータ結合をしたいのですが、
パワークエリですとシート名が異なるデータの一括結合はできず困ってます。

こちらでフォルダにあるシート名を一括変更するマクロが記載されていましたので、
これだ！と思い
そちらを使わせていただいたのですが自宅のPCでは正常に変更できるものの、
会社のPCではエラーが発生して変更ができませんでした。
下記のマクロの　５行目　myfile = dir(mypath & "*.xls*")　でエラーとなります。
コピペをして使いましたので入力間違いではないと思います。

原因はなんでしょうか？ほかに何か良い方法はありますでしょうか？


作業用のブックを一つ用意する
ＡＬＴ＋Ｆ１１を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
　dim myPath as string
　dim myFile as string

　mypath = thisworkbook.path & "\"
　myfile = dir(mypath & "*.xls*")
　application.screenupdating = false

　do until myfile = ""
　　if myfile <> thisworkbook.name then
　　workbooks.open filename:=mypath & myfile
　　activeworkbook.worksheets(1).name = "sheet1"
　　activeworkbook.close savechanges:=true
　　end if
　　myfile = dir()
　loop
　application.screenupdating = true
end sub

ファイルメニューから終了してエクセルに戻る
ブックを，100個のブックが保存してある同じフォルダに保存する
ＡＬＴ＋Ｆ８を押してマクロを実行する。

質問者からの補足コメント

• 

  調べていたところ、こちらのサイトに行きついたのですが、
  https://qiita.com/yoshi2045/items/527c0d196978b0 …
  自力では書き換えられず。
  Qchan1962さん
  アドバイス頂けたりしないでしょうか？

  No.3の回答に寄せられた補足コメントです。 補足日時：2022/09/26 17:21

No.7 回答者： Qchan1962 回答日時： 2022/09/27 23:30

こんばんは

＞ご迷惑をおかけして申し訳ありません。
そのような事はありませんので気になさらずに・・
著作者の方（黒い箱の中　黒箱様）から返信がありましたので　追記しておきます
当スレッドの回答＃５及び関連する記事については、コード本体の掲載が無いことなどから、配慮を頂きました

＞ ６行目のOneDriveUrlToLocalPathで配列がありませんとのエラーが

配列に関するコードは無くFunctionにおいても　あくまで文字列型を引数としています（戻り値も文字列型）
アドレスを配列にして　後の配列ループで処理をされたいと言う事であれば
配列を作成する時に１つずつファンクションに値を渡し戻り値を配列に格納するようにします
調べられるとの事なので健闘を祈ります

No.6 回答者： Qchan1962 回答日時： 2022/09/26 20:32

＃５です

すみません補足追記します。
ご質問の補足コメントにあるサイトの中にある参考リンクサイトの
FunctionコードはCopyrightが明記されライセンス宣言GPL-3.0を掲示されています

＞自力では書き換えられず。
＃５にも書きましたが、使用にあたっては当該サイトの規約を厳守してください

Function名を変えずに回答しましたので、Function呼び出し方法の例として回答した事を当該サイトへ報告しました。
（著作者の意図しない普及に抵触する恐れがある為）

この回答へのお礼

Qchan1962 さん
いろいろ有難うございます。

＞＃５にも書きましたが、使用にあたっては当該サイトの規約を厳守してくだ＞さい
＞Function名を変えずに回答しましたので、Function呼び出し方法の例とし＞て回答した事を当該サイトへ報告しました。
＞（著作者の意図しない普及に抵触する恐れがある為）

ご迷惑をおかけして申し訳ありません。
承知いたしました。

＃５ のコードを動かしたら ６行目のOneDriveUrlToLocalPathで
配列がありませんとのエラーが。
Function の理解不足ですので、これから調べてみようと思います。
ご丁寧に何度も教えていただき、ありがとうございます。

お礼日時：2022/09/26 20:55

No.5 回答者： Qchan1962 回答日時： 2022/09/26 19:06

こんばんは

行きついたサイトのFunctionを使用する場合、＃３のコードをどうすれば良いかと言う事でしょうか？
パスを使用（取得）する部分でFunctionに渡せば良い事になりますので

Sub Sample()
Dim f As Object
With CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
On Error Resume Next
For Each f In .GetFolder(OneDriveUrlToLocalPath(ThisWorkbook.Path)).Files
If f.Name <> ThisWorkbook.Name And .GetExtensionName(f.Name) Like "xls*" Then
With Workbooks.Open(Filename:=OneDriveUrlToLocalPath(f.Path))
.Worksheets(1).Name = "sheet1"
.Close savechanges:=True
End With
End If
Next f
Application.ScreenUpdating = True
End With
End Sub

かな？
上手くいかない（何も変化がない）場合は、On Error Resume Nextをコメントにしてエラーを（F8実行で）確認してください。

同期している事が条件のようですね。私はOneDriveを使っていませんので試していません
参考サイトを評価することは出来ませんので、Functionの使用にあたっては
参考サイトの規約に従ってくださいね

No.4 回答者： KenKen_SP 回答日時： 2022/09/23 02:53

こんばんは。

うろ覚えですが、OneDrive に保存されたファイルだと

　　ThisWorkbook.Path

の様な Path プロパティーが https://～ の様に URL で返る場合があると記憶しています。

私自身は OneDrive を利用していないので詳しくありませんが、URL が返ったとすれば、Dir 関数や Scripting.FileSystemObject ではエラーになりそうですね。

この時 URL となってしまったパスを ローカル OneDrive フォルダへのパスに変換してあげれば良いのですが、ちょうど同じ様な内容の記事がありましたので、リンクを貼っておきます。

https://tsurutoro.com/vba-trouble/

この回答へのお礼

KenKen＿SPさん
ありがとうございます！

確かに、 https://～ の様に URL になってました。
なるほど。これが原因でエラーになっていたのですね。
原因がわかってちょっとすっきりです。

https://tsurutoro.com/vba-trouble/　調べていただいた記事と
https://kuroihako.com/vba/onedriveurltolocalpath/　
こちらを参考に、ちょっと頑張ってみます。

お礼日時：2022/09/23 22:56

No.3 回答者： Qchan1962 回答日時： 2022/09/23 00:50

＃１です

一応可能性を書きましたが・・

使い捨ての加工用VBAで且つ、ご自身で色々探して理解されているようですので　＃１の内容を前提にコードを書きました
（おっしゃるように問題がネットワークドライブなどの場合はセキュリティ的な問題もあるかも知れませんので環境で（デスクトップなどで）対応してください）

＞52 ファイル名または番号が不正です…と出ます
Dir関数で取得できない文字列名などの問題を対策しています
多分エラーは出ないと思うのですが・・パスに問題があると出るかも

同名シート対策（やっつけ）
On Error Resume Next　はエラーがあった場合飛ばして次に進みます
（アバウトに表現するとエラーのあるコード行を処理しないと言う事です）

Sub Sample()
Dim f As Object
With CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
For Each f In .GetFolder(ThisWorkbook.Path).Files
If f.Name <> ThisWorkbook.Name And .GetExtensionName(f.Name) Like "xls*" Then
On Error Resume Next
With Workbooks.Open(Filename:=f.Path)
.Worksheets(1).Name = "sheet1"
.Close savechanges:=True
End With
End If
Next f
Application.ScreenUpdating = True
End With
End Sub

Dir関数でパスを取得するのに対しScripting.FileSystemObjectでフォルダ内のオブジェクトを取得しています

Dir関数より処理速度が少し遅いですが100ファイル位では問題ないと思います
メイン処理はそのままですので説明は割愛します

試す場合は、コピーファイルなどを用意して自己責任で行ってください
（一応、ローカルで検証しましたがダメでしたら捨ててください）

この回答へのお礼

Qchan1962さん

ご親切にいろいろ考えて下さりありがとうございます。
先ほど、帰宅して早速書いて頂いたマクロを動かしてみましたが、

やはり５行目の
For Each f In .GetFolder(ThisWorkbook.Path).Files　のところで
76　パスが見つかりません

となってしまいます。
やはりOneDriveがネックなのでしょうかね。

お礼日時：2022/09/23 20:57

No.2 回答者： 銀鱗 回答日時： 2022/09/22 23:19

ファイル拡張子が ”.xls” ではなく ”.xlsx” なんて話のオチを期待してみる。

この回答へのお礼

銀鱗さん…
ありがとうございます。
私もそこは期待して試した箇所です。。
しかし、そこではなかった…んです(T . T)

お礼日時：2022/09/23 00:15

No.1 回答者： Qchan1962 回答日時： 2022/09/22 23:09

こんばんは、

手順は間違っていないと思いますし自宅のPCでは正常・・
バージョンなどの依存コードは無い様な・・・

フォルダはローカルにあるものですよね？デスクトップとか・・
また、フォルダ名やファイル名に依存文字（UNICODE）㉑のような名前を付けていませんか？

エラー番号（内容）は、何ですか？

ちなみに保存せずに実行するとthisworkbook.pathは取得できないので
エラーが返ります

あと、これは無い事が前提かも知れませんが、変更しようとするシート名が既にある場合、エラーが返りますので対策が必要になります
（使い捨ての加工用VBAでこのような事が無ければ無視して良いです）

いずれかに該当する場合、コードを変更するか環境を変えるかが必要と思います

この回答へのお礼

Qchan1962さん
早々にありがとうございます〜

▷フォルダはローカルにあるものですよね？

はい。ローカルにあります。会社のPCはOneDrive上にあるのとセキュリティがかたいです…

▷フォルダ名やファイル名に依存文字のような名前を付けていませんか？

はい。それはないです。

▷エラー番号（内容）は、何ですか？

52 ファイル名または番号が不正です…と出ます

▷ちなみに保存せずに実行するとthisworkbook.pathは取得できないので
エラーが返ります

なるほどです。一応保存はしてます…

▷変更しようとするシート名が既にある場合、エラーが返ります…

なるほど。こちらも同じシート名はないですねー

何となくお聞きした感じですと、ファイルの保存場所のような気がしますね。VBA難しいです…

お礼日時：2022/09/23 00:29