|
▼ひろのしま さん:
>※いつも適切な回答をいただき、まことにありがとうございます。顧客データそのものが外部漏れ禁止なので、
>コメント注のファイル名やシート名に若干の変更を加えております。ご了承ください。
>
>私のやりたいことなのですが、6つに分類されたフォルダ内の、’左3文字’と*_再開する番組一覧表_*,という文字のついたエクセルファイル名を検索し、存在していた時に、特定のセル部分のデータをアクセスにインポートして
>アクセスデータとして残す、という作業なのです。
>で、問題なのは、下記の処理を2回〜5回ほど繰り返した頃にフリーズし、「芸能人_再開する番組一覧表_〜.xlsは、[編集]を選択すると、開いたファイルを編集できます。」というメッセージボックスが出てきてしまいます。
>最初からでなく2〜5回ほど行った後のエラーなので、なかなか原因がつかめません。
>なにか行ってはいけないコマンドをしているのでしょうか?良きアドバイスをお願いします。
>
>'最初に、報告書マスタテーブルを、サービス種別(chnl_bunrui)分インポートする上限-----------
>'チャンネル分類変数------
>Dim SVcnt As Integer 'チャンネル分類カウント
>Dim Chnl_Bunrui As String 'チャンネル分類別フォルダ
>Dim Hairetu As Variant 'チャンネル分類名保存変数
>Hairetu = Array("AV", "音楽番組", "ドラマ", "ニュース”, "お笑い番組", "ドキュメンタリー”)
>
> '該当する芸能人再開する番組一覧表があれば、再開する番組一覧表をあけ、報告書フォーマットに値を記入する上限------------------
>
>For SVcnt = 0 To 5 'チャンネル分類別ステートメント上限------------------------------------
> Chnl_Bunrui = Hairetu(SVcnt)
>
> 'チャンネル分類別に再開する番組一覧表を取り出す------------------
> Dim File_Cnt As Integer 'ファイルカウント変数
> Dim File_Sum As Integer 'ファイル総数変数
> Dim File_SaiKS As String 'パス有再開する番組一覧表
> Dim File_SaiKS_Cut As String 'パス無再開する番組一覧表
> '初期化
> File_SaiKS_Cut = ""
> File_SaiKS = ""
> File_Sum = 0
> File_Cnt = 0
>
> ChDir Path_SaiKS & Chnl_Bunrui & "\"
> File_SaiKS = Dir(Path_SaiKS & Chnl_Bunrui & "\" & Me.芸能人 & "_再開する番組一覧表_*.xls", vbDirectory)
> Do Until File_SaiKS = ""
> If Replace(File_SaiKS, Path_SaiKS & Chnl_Bunrui & "\", "") Like "" & Me.芸能人 & "_再開する番組一覧表_*.xls" Then
> File_Cnt = File_Cnt + 1
> File_SaiKS_Cut = Replace(File_SaiKS, Path_SaiKS & Chnl_Bunrui & "\", "") 'パス名を削除=>でないとブック名を指定できないため
> End If
>
> File_SaiKS = Dir()
> Loop
> File_Sum = File_Cnt
>
>
> If File_Sum = 0 Then
> 'ファイルがなければその芸能人はなにも作成しない。
> ElseIf File_Sum >= 2 Then
> MsgBox Me.芸能人 & "に該当する再開する番組ファイルが複数存在していますので、どちらかを削除してから行ってください。"
> End
> Else
> '再開する番組一覧表エクセル変数----------------------
> Dim WKB_SaiKS As Excel.Workbook '精再開する番組ファイル
> Dim WKS_SaiKS As Excel.Worksheet '各芸能人の再開する番組シート
> Set Exl = CreateObject("Excel.Application")
> Set WKB_SaiKS = Exl.Workbooks.Open(Path_SaiKS & Chnl_Bunrui & "\" & File_SaiKS_Cut) '精算付再開する番組ファイル
> Debug.Print "Openfilename" & Path_SaiKS & Chnl_Bunrui & "\" & File_SaiKS_Cut
> Set WKS_SaiKS = WKB_SaiKS.Worksheets("Sheet1")
>' WKS_SaiKS.Select
>
>
> '再開する番組一覧表の、合計以下3段のインポート--------------
> Call Moju_報告書マスタテーブル
> Dim Sai_Cnt As Long '再開する番組数カウント
> Dim Sai_Sum As Long '再開する番組数合計
>
> Dim TBLDB As Database 'データベース
> Set TBLDB = CurrentDb 'データベース変数
> Dim TDF As TableDef 'テーブル変数
>
> With WKS_SaiKS
> '.Activate
> Sai_Sum = .Range("A1:A65536").Find(what:="合計").Row - 2 - 1 '再開する番組数合計,-2は行標題、-1は列標題
> 'チャンネルと芸能人が該当する再開する番組テーブルがあれば、先に削除しておく。
> TBL_Keyword = StrConv(Me.芸能人, vbWide) & Replace(Chnl_Bunrui, "-", "") & "報告書マスタ"
> Call Moju_テーブルクエリ確認
> If TBL_HIT = 1 Then
> DoCmd.RunSQL "Drop Table " & StrConv(Me.芸能人, vbWide) & Replace(Chnl_Bunrui, "-", "") & "報告書マスタ;"
> End If
> DoCmd.SetWarnings False
> '報告書マスタテーブルにインポートする前に、チャンネルと芸能人に該当する報告書マスタテーブルのデータがあれば、削除しておく。
> DoCmd.RunSQL "Delete * From 報告書マスタ where [芸能人]='" & Me.芸能人 & "' and [チャンネル]='" & Chnl_Bunrui & "';"
>
> 'チャンネルと芸能人が該当する再開する番組一覧表の合計以下3段のインポート上限-----------
> DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, StrConv(Me.芸能人, vbWide) & Replace(Chnl_Bunrui, "-", "") & "報告書マスタ", Path_SaiKS & Chnl_Bunrui & "\" & File_SaiKS_Cut, False, .Name & "!" & Replace(.Range(.Cells(2 + Sai_Sum + 1, 1), .Cells(2 + Sai_Sum + 3, 4 + 5 * (Tuki_Sa + 1) + 7 * (Nen_Sum + SouGoukei))).Address, "$", "")
> DoCmd.RunSQL "Update " & StrConv(Me.芸能人, vbWide) & Replace(Chnl_Bunrui, "-", "") & "報告書マスタ Set F3='" & Me.芸能人 & "', F4='" & Chnl_Bunrui & "';"
>
> 'テーブルの列の名前を変更する---------。
> Set TDF = TBLDB.TableDefs(StrConv(Me.芸能人, vbWide) & Replace(Chnl_Bunrui, "-", "") & "報告書マスタ")
> For FLD_Cnt = 1 To TDF.Fields.Count
> TBLDB.TableDefs(StrConv(Me.芸能人, vbWide) & Replace(Chnl_Bunrui, "-", "") & "報告書マスタ").Fields(FLD_Cnt - 1).Name = TBLDB.TableDefs("報告書マスタ").Fields(FLD_Cnt - 1).Name
> Next
>
> DoCmd.RunSQL "INSERT INTO 報告書マスタ " & _
> "SELECT " & StrConv(Me.芸能人, vbWide) & Replace(Chnl_Bunrui, "-", "") & "報告書マスタ.* " & _
> "FROM " & StrConv(Me.芸能人, vbWide) & Replace(Chnl_Bunrui, "-", "") & "報告書マスタ;"
> 'チャンネルと芸能人が該当する報告書マスタのテーブルを削除する。
> DoCmd.RunSQL "Drop Table " & StrConv(Me.芸能人, vbWide) & Replace(Chnl_Bunrui, "-", "") & "報告書マスタ;"
> 'チャンネルと芸能人が該当する再開する番組一覧表の合計以下3段のインポート上限-----------
> DoCmd.SetWarnings True
> End With
> Debug.Print "closefilename" & Exl.ActiveWorkbook.Name
> WKB_SaiKS.Close
>'
> ' Exl.ActiveWorkbook.Close
> Exl.Quit
> Set WKS_SaiKS = Nothing
> Set WKB_SaiKS = Nothing
>
> End If '該当芸能人再開する番組一覧表があれば、再開する番組一覧表をあけ、報告書フォーマットに値を記入する下限------------------
>Next
すみません。かなり長い質問だったので、誰も見る気がしなかったと思います。
ですが、自分自身で解決してしまいましたので、回答いたします。
エクセルファイルを読取専用で開かない限り、そのままcloseしてもQuitしても
編集メッセージは出てくるということです。以上、お騒がせ致しました.
|
|