質問編集履歴

1 全体のソースコードを追記しました

Windshower0704

Windshower0704 score 10

2019/04/23 09:36  投稿

実行時エラー 1004 "*****(対象ファイル名)"にアクセスできません。対応方法
実行時エラー 1004 "*****(対象ファイル名)"にアクセスできません。対応方法をご教示ください。
### 前提・実現したいこと
CSVにて落とし込んだファイルを2つに分割するマクロを組んでおります。
2つのファイルに分割する際に以下のエラーメッセージが発生しました。
実際は2つのファイルに分割できているようなのですが、片方のファイルに以下のエラーメッセージが出ております。
発生している問題・エラーメッセージ
```
 
実行時エラー 1004
 
"*****(対象ファイル名)"にアクセスできません。
```
### 該当のソースコード(VBA)
```
問題になっている該当のソースコード(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  
```  
対応方法をご教示ください、よろしくお願いいたします。
  • VBA

    5047 questions

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

思考するエンジニアのためのQ&Aサイト「teratail」について詳しく知る