| |
※いつも適切な回答をいただき、まことにありがとうございます。顧客データそのものが外部漏れ禁止なので、
コメント注のファイル名やシート名に若干の変更を加えております。ご了承ください。
私のやりたいことなのですが、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
|
|
ひろのしま
- 05/2/3(木) 10:38 -
