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

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

ただいまの
回答率

88.05%

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

受付中

回答 0

投稿 編集

  • 評価
  • クリップ 2
  • VIEW 1,689

score 10

前提・実現したいこと

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

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

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

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

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

    クリップを取り消します

  • 良い質問の評価を上げる

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

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

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

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

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

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

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

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

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

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

  • ただいまの回答率 88.05%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

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

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