質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
87.20%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

解決済

ファイル名・フォルダ名の一部をセルの値へ変更したい。

haru4
haru4

総合スコア11

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

1回答

0評価

0クリップ

288閲覧

投稿2022/02/04 10:58

編集2022/02/16 08:54

お世話になります。
エラーが解消できず行き詰っているためご教示お願いいたします。
下記コード実行時、「ファイル名を変更して保存」のSaveAsの部分で実行時エラー:オートメーションエラー となります。

実現したい動作

・C\AAA\BBB\CCC\DDD\保存フォルダ にサブフォルダ”000000000(111)氏名”が10件前後あるものとします。
・サブフォルダ内には【資料】000000000(111)氏名.xlsx というファイルが必ず存在しており、”00000000(111)氏名”の部分は必ず一致しています。

1. サブフォルダ内のファイル【資料】000000000(111)氏名.xlsxを開く
2. G14の値を変数numへ格納
3. numを半角へ変換
4. サブフォルダ名とファイル名の()内の値をnumの値に置換

Sub 置換作業() Dim buf As String   ‘サブフォルダ名 Dim cnt As Long   ’サブフォルダカウント用 Dim wb As Workbook ‘【資料】~.xlsxファイル Dim ws As Worksheet ‘上記ファイルの指定シート Dim num As String  ‘上記シートのセル値 Dim FileName_1 As Variant ‘【資料】ファイルの分割(前半) Dim e As Long       ‘bufの後ろ括弧の文字位置 Dim FileName_2 As Variant ‘【資料】ファイルの分割(後半) Dim New_wb As Variant  ‘新規ファイル名 Dim New_fol As String   ‘num置換後のサブフォルダ Const Path As String = ” C\AAA\BBB\CCC\DDD\保存フォルダ\ With Application .ScreenUpdating=False .DisplayAlerts=False End With buf = Dir(Path,vbDirectory) cnt = 1 ‘保存フォルダの中のサブフォルダを開く Do While buf <>”” ‘・と・・のフォルダは処理を飛ばす If buf <> ”.” And buf <> “..” Then ChDir Path Set wb = Workbooks.Open(Path & buf & “【資料】” & buf & “.xlsx”) Wb.Activate Set ws = wb.Sheets(“Sheet1”) ‘G14セルの値を変数numへ格納 num = ws.Cells(14,7) ‘numを半角変換 Cells(14,7) = StrConv(num,vbNarrow) num = Cells(14,7).Value ‘新規ファイル名を作成 FileName_1 = Left(buf,16) e = InStrRev(buf,”)”) FileName_2 = Mid(buf,e) ‘サブフォルダ名を修正 ‘※同名フォルダがすでに存在する場合()の中の値とnum(※半角)が完全一致する場合には処理を飛ばす⇒ファイル名の変更も不要 New_fol = Path & FileName_1 & num & FileName_2 If Path & buf = New_fol Then GoTo Jump Name Path & buf As New_fol Jump: ‘ファイル名を変更して保存 New_wb = New_fol & “【資料】” & FileName_1 & num & FileName_2 & “.xlsx” wb.SaveAs New_wb wb.Close False End If cnt = cnt + 1 buf = Dir() Loop With Application .ScreenUpdating=True .DisplayAlerts=True End With End Sub

良い質問の評価を上げる

以下のような質問は評価を上げましょう

  • 質問内容が明確
  • 自分も答えを知りたい
  • 質問者以外のユーザにも役立つ

評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

気になる質問をクリップする

クリップした質問は、後からいつでもマイページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

  • プログラミングに関係のない質問
  • やってほしいことだけを記載した丸投げの質問
  • 問題・課題が含まれていない質問
  • 意図的に内容が抹消された質問
  • 過去に投稿した質問と同じ内容の質問
  • 広告と受け取られるような投稿

評価を下げると、トップページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

Usirow

2022/02/05 06:15 編集

どこでエラーが出ているのかはわかりますか? あと、ファイル名を変更して保存の箇所、おそらくNew_folとする部分がNew folとなっていますが、ここは大丈夫でしょうか?
haru4

2022/02/06 05:27

Usirow様 お返事ありがとうございます。 ‘ファイル名を変更して保存 New_wb = New fol & “【資料】” & FileName_1 & num & FileName_2 & “.xlsx” wb.SaveAs New_wb ←ここで標題の通り、オートメーションエラーとでます。 誤字失礼いたしました。 実際のコードは New_fol となっています。
Usirow

2022/02/07 01:11

すみません。先に聞くべきでしたが、そもそもどんなエラーメッセージが出ていますか?
haru4

2022/02/08 06:57

失礼いたしました。 何度か試行してみたところ、エラーの表示が変わりまして 'フォルダの中の【調査依頼書】~.xlsxを開く ChDir Path Set wb = Workbooks.Open(Path & buf & "\【資料】" & buf &".xlsx") ←この部分で ‘実行時エラー1004’ C\AAA\BBB\CCC\DDD\保存フォルダ\【資料】0000000(111)氏名.xlsxにアクセスできません。 と出ています…。
haru4

2022/02/08 07:06

追記 度々失礼いたします。 保存フォルダの上から13番目のサブフォルダの動作の途中にエラーになっているようです。 また、動作済のサブフォルダ内を1件ずつ確認したところ、【資料】~ファイルが消えてしまっていたので、ファイルが見つからないというエラーが出ているのかと... 恐らく置換後のパス指定から大きく間違いがあるように思います。
haru4

2022/02/09 06:46

'修正後ファイルを保存 の最後に 作成段階で加えた Kill New_fol & "\【資料】" & buf & ".xlsx" の記述が残っていたため、元ファイルが削除されていたようでした。(当然ですね・・・) この部分をコードから削除し、サブフォルダへファイルを作成し直しましたが それでも尚、‘実行時エラー1004’ C\AAA\BBB\CCC\DDD\保存フォルダ\【資料】0000000(111)氏名.xlsxにアクセスできません。 が表示されております。 度々申し訳ございませんが、お力添え頂けますと幸いです。
Usirow

2022/02/10 01:31

そのC\AAA~というパスは、C:\AAA~の間違いではないですか?

まだ回答がついていません

会員登録して回答してみよう

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
87.20%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問

同じタグがついた質問を見る

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。