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

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

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

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

Q&A

0回答

413閲覧

実行時エラー 1004 "*****(対象ファイル名)"にアクセスできません。対応方法をご教示ください。

Windshower0704

総合スコア10

VBA

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

0グッド

2クリップ

投稿2019/04/22 05:51

編集2022/01/12 10:55

前提・実現したいこと

CSVにて落とし込んだファイルを2つに分割するマクロを組んでおります。

2つのファイルに分割する際に以下のエラーメッセージが発生しました。

実際は2つのファイルに分割できているようなのですが、片方のファイルに以下のエラーメッセージが出ております。

発生している問題・エラーメッセージ

実行時エラー 1004 "*****(対象ファイル名)"にアクセスできません。

問題になっている該当のソースコード(VBA)

   Workbooks(strFormatBookName).SaveAs Filename:=strOutputFolder & "\" & strStatusName(lStatusCnt) & "\" & strOutputFileName, FileFormat:=xlWorkbookDefault

全体のソースコード

Option Explicit Dim lOptionButton As Long Sub OptionButton1_Click() lOptionButton = 1 End Sub Sub OptionButton2_Click() lOptionButton = 2 End Sub Function GetOptionButton() As Long Dim lCnt As Long Dim lTarget As Long For lCnt = 1 To 2 lTarget = ActiveSheet.OptionButtons("Option Button " & lCnt).Value If lTarget = 1 Then GetOptionButton = lCnt Exit Function End If Next GetOptionButton = 1 End Function Sub CallListMake() Dim lStatusCnt As Long Dim strStatusName() As String strStatusName = Split("審査依頼済,審査保留", ",") Dim bErrFlg As Boolean Dim bCompany As Boolean Dim strInputFolder As String Dim strOutputFolder As String Dim strInputFileName As String Dim strFormatFileName As String Dim strOutputFileName As String Dim lInputStartRow As Long Dim lOutputStartRow As Long Dim lInputCntRow As Long Dim lOutputCntRow As Long Dim lInputMaxRow As Long Dim strFormatBookName As String Dim strInputBookName As String Dim lCallListFileNo As Long Dim lCallListMaxRow As Long strInputFolder = Range("K5").Value strOutputFolder = Range("K6").Value strFormatFileName = Range("K7").Value lCallListMaxRow = Range("K8").Value lOptionButton = GetOptionButton lInputStartRow = 2 lOutputStartRow = 2 '・申込・契約情報_yyyymmddhhssMM.cxvを開く・・以下 InputFile ' →最初はファイルを手動で読込でリリース、架電リスト作成ツールができたら最新1ファイルを開くに仕様変更する If lOptionButton = 1 Then strInputFileName = Dir(strInputFolder & "\" & "*.csv", vbNormal) If strInputFileName = "" Then GoTo END_LABEL: End If Workbooks.Open Filename:=strInputFolder & "\" & strInputFileName Else ChDrive Left(strInputFolder, 3) ChDir strInputFolder Call FileOpen("CSVファイル(*.csv?),*.csv?", 1, "申込・契約情報_*.csvを開く", False, "申込・契約情報_*.csv", "申込・契約情報", bErrFlg) If bErrFlg Then GoTo END_LABEL: End If End If strInputBookName = ActiveWorkbook.Name lInputMaxRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row ' 申込番号で昇順にソート Add 2018/03/16 H.Miki Dim lInputMaxCol As Long lInputMaxCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column Workbooks(strInputBookName).Worksheets(1).Range(Workbooks(strInputBookName).Worksheets(1).Cells(2, 1), Workbooks(strInputBookName).Worksheets(1).Cells(lInputMaxRow, lInputMaxCol)).Sort _ Key1:=Workbooks(strInputBookName).Worksheets(1).Cells(1, 1), order1:=xlAscending, Header:=xlNo, DataOption1:=xlSortTextAsNumbers ' 画面の更新を停止、不要な画面描画を抑止する Application.ScreenUpdating = False For lStatusCnt = LBound(strStatusName) To UBound(strStatusName) ' 配列の各要素を順に処理 '・「\web申込入居審査」の「03_架電リストフォーマット.xlsx」を開く・・以下 FormatFile Workbooks.Open Filename:=strFormatFileName strFormatBookName = ActiveWorkbook.Name Workbooks(strInputBookName).Activate '・InputFileの申込・契約ステータスが審査依頼済の行の以下列をFormatFileに張り付け ' →申込番号、申込・契約ステータス、個人/法人、契約者氏名、契約者氏名カナ、商品、契約時条件 '・InputFileの最終行まで繰り返し lOutputCntRow = lOutputStartRow lCallListFileNo = 1 For lInputCntRow = lInputStartRow To lInputMaxRow ' 申込受付日が現在よりも2か月以内で無い場合は読み飛ばし Add 2018/03/16 H.Miki If Workbooks(strInputBookName).Worksheets(1).Cells(lInputCntRow, 9).Value < DateAdd("m", -2, Now) Then GoTo Continue: If Workbooks(strInputBookName).Worksheets(1).Cells(lInputCntRow, 3).Value = strStatusName(lStatusCnt) Then bCompany = False If Workbooks(strInputBookName).Worksheets(1).Cells(lInputCntRow, 4).Value = "法人" Then ' 法人の場合は法人名が名前に入る 編集2018/05/7 horiuchi bCompany = True End If Workbooks(strFormatBookName).Worksheets(1).Cells(lOutputCntRow, 1).Value = "" Workbooks(strFormatBookName).Worksheets(1).Cells(lOutputCntRow, 2).Value = Workbooks(strInputBookName).Worksheets(1).Cells(lInputCntRow, 1).Value '. 申込番号 編集2018/05/7 horiuchi Workbooks(strFormatBookName).Worksheets(1).Cells(lOutputCntRow, 3).Value = Workbooks(strInputBookName).Worksheets(1).Cells(lInputCntRow, 24).Value '. 担当者氏名 編集2018/07/10 horiuchi Workbooks(strFormatBookName).Worksheets(1).Cells(lOutputCntRow, 4).Value = Workbooks(strInputBookName).Worksheets(1).Cells(lInputCntRow, 9).Value '. 申込受付日 編集2018/05/7 horiuchi Workbooks(strFormatBookName).Worksheets(1).Cells(lOutputCntRow, 5).Value = Workbooks(strInputBookName).Worksheets(1).Cells(lInputCntRow, 78).Value '. 商品 If bCompany = False Then Workbooks(strFormatBookName).Worksheets(1).Cells(lOutputCntRow, 6).Value = Workbooks(strInputBookName).Worksheets(1).Cells(lInputCntRow, 102).Value '.【個人】氏名 編集2018/05/7 horiuchi Workbooks(strFormatBookName).Worksheets(1).Cells(lOutputCntRow, 7).Value = Workbooks(strInputBookName).Worksheets(1).Cells(lInputCntRow, 103).Value '.【個人】氏名(カナ) 編集2018/05/7 horiuchi Else Workbooks(strFormatBookName).Worksheets(1).Cells(lOutputCntRow, 6).Value = Workbooks(strInputBookName).Worksheets(1).Cells(lInputCntRow, 153).Value '.【法人】会社名 編集2018/05/7 horiuchi Workbooks(strFormatBookName).Worksheets(1).Cells(lOutputCntRow, 7).Value = Workbooks(strInputBookName).Worksheets(1).Cells(lInputCntRow, 154).Value '.【法人】会社名(カナ) 編集2018/05/7 horiuchi End If Workbooks(strFormatBookName).Worksheets(1).Cells(lOutputCntRow, 8).Value = Workbooks(strInputBookName).Worksheets(1).Cells(lInputCntRow, 16).Value '.契約時条件 編集2018/05/7 horiuchi Workbooks(strFormatBookName).Worksheets(1).Cells(lOutputCntRow, 9).Value = Workbooks(strInputBookName).Worksheets(1).Cells(lInputCntRow, 25).Value '.(基本情報)備考 編集2018/05/7 horiuchi Workbooks(strFormatBookName).Worksheets(1).Cells(lOutputCntRow, 10).Value = Workbooks(strInputBookName).Worksheets(1).Cells(lInputCntRow, 4).Value '.個人/法人 編集2019/03/12horiuchi lOutputCntRow = lOutputCntRow + 1 '・1ファイルあたりの件数に達した場合、FormatFileを「\web申込入居審査\03_架電リスト\審査依頼済」に名前を付けて保存・・以下 OutputFile If (lOutputCntRow - lOutputStartRow) >= lCallListMaxRow Then Application.DisplayAlerts = False strOutputFileName = "架電リスト_" & strStatusName(lStatusCnt) & "_" & Format(Now, "yyyymmdd") & "_" & Format(lCallListFileNo, "000") & ".xlsx" Workbooks(strFormatBookName).SaveAs Filename:=strOutputFolder & "\" & strStatusName(lStatusCnt) & "\" & strOutputFileName, FileFormat:=xlWorkbookDefault Workbooks(strOutputFileName).Close savechanges:=False Workbooks.Open Filename:=strFormatFileName Workbooks(strInputBookName).Activate lOutputCntRow = lOutputStartRow lCallListFileNo = lCallListFileNo + 1 Application.DisplayAlerts = True End If End If Continue: Next Application.DisplayAlerts = False strOutputFileName = "架電リスト_" & strStatusName(lStatusCnt) & "_" & Format(Now, "yyyymmdd") & "_" & Format(lCallListFileNo, "000") & ".xlsx" Workbooks(strFormatBookName).SaveAs Filename:=strOutputFolder & "\" & strStatusName(lStatusCnt) & "\" & strOutputFileName, FileFormat:=xlWorkbookDefault Workbooks(strOutputFileName).Close savechanges:=False Application.DisplayAlerts = True Next Application.DisplayAlerts = False Workbooks(strInputBookName).Close savechanges:=False Application.DisplayAlerts = True END_LABEL: Application.ScreenUpdating = True End Sub Sub FileOpen(WkFileFilter, WkFilterIndex, WkTitle, WkMultiSelect, WkFilename, WkErr, bErrFlg) Dim OpenFileName As String Dim WKBook_Name As String Dim PathName As String Dim pos As Long Dim flag As Boolean Dim wb As Workbook bErrFlg = False ' ダイアログを開く OpenFileName = Application.GetOpenFilename( _ FileFilter:=WkFileFilter _ , FilterIndex:=WkFilterIndex _ , Title:=WkTitle _ , MultiSelect:=WkMultiSelect _ ) pos = InStrRev(OpenFileName, "\") PathName = Left(OpenFileName, pos) WKBook_Name = Mid(OpenFileName, pos + 1) flag = False ' 現在開いているワークブックを検索 For Each wb In Workbooks ' 開いているワークブックが取得したファイル名と一致 If wb.FullName = OpenFileName Then flag = True Exit For End If Next wb If flag = True Then bErrFlg = True MsgBox OpenFileName & "は既に開いているため閉じてください。" GoTo END_LABEL: End If If OpenFileName <> "False" Then If WKBook_Name Like WkFilename Then Workbooks.Open OpenFileName Else bErrFlg = True MsgBox WkErr & "ファイルが選択されていません。" GoTo END_LABEL: End If Else bErrFlg = True MsgBox WkErr & "ファイルを選択してください。" GoTo END_LABEL: End If END_LABEL: End Sub

対応方法をご教示ください、よろしくお願いいたします。

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

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

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

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

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

アカウントをお持ちの方は

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

ただいまの回答率
85.50%

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

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

質問する

関連した質問