ACCESS2003で改修依頼管理ツールを作成

このQ&Aのポイント
  • ACCESS2003の改修依頼管理ツールを作成しています。回答票の出力時に同名ファイルが存在するとエラーが発生するため、回避方法を知りたいです。
  • 現在、ACCESS2003で改修依頼管理ツールを作成しています。回答票テンプレートを使用してデータをコピーして保存する際、同名ファイルが存在するとエラーが出てしまいます。解決方法を教えていただけないでしょうか。
  • ACCESS2003で改修依頼管理ツールを作成中です。回答票のテンプレートを使用してデータをコピーして保存することで回答票を作成していますが、同名ファイルが存在する場合にエラーが発生します。回避方法を教えてください。
回答を見る
  • ベストアンサー

ACCESS2003で改修依頼管理ツールを作成しています。

ACCESS2003で改修依頼管理ツールを作成しています。 改修依頼用の回答票を出力する際のことなんですが、 現在、回答票テンプレートをあらかじめ同フォルダ内に保存していて、 それをExcelAppで開き、回答内容テーブルのデータをそのままコピーして名前をつけて保存しています。 しかし、その方法だとすでに同じ名前のファイルが存在していると名前をつけて保存する際に、同ファイルにアクセスできませんとエラーが出ます。 デバッグしてみるとどうやらテンプレートを開く際に読取専用で開かれており、 それを編集して別名で保存しているため、作成したファイルも読取専用ファイルになっているため 2回目以降に同名で出力する際に同ファイルにアクセスできなくなっているのだと思います。 これを回避する方法を知っている方がいれば是非教えていただきたいです。 コードを見ていただくわかると思いますが保存名の定義が部署名&発行日付のため1日に2回以上同じ部署の回答票を発行する際に困っています。 一応コードも載せておきます。 'On Error GoTo Err_コマンド0_Click Dim xlApp As Object Dim xlBook As Object Dim strMDBPATH As String 'MDBの保存場所、フォルダー・ディレクトリ Dim strXLSFILE As String 'テンプレートファイルの名前、e:\xxx\yyyy\テンプレート.xls Dim strSaveFile As String strMDBPATH = GetCrtPath 'Excelの元ファイルの名前を作成 D:\xxxx\yyyy\ + テンプレート.xls strXLSFILE = strMDBPATH & "回答票テンプレ.xls" '変数にエクセルアプリケーションをセットして開く Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Open(FileName:=strXLSFILE, ReadOnly:=False) xlApp.Visible = True '回答票テンプレを開く ' xlApp.Workbooks.Open FileName:=strXLSFILE '回答票に回答内容をコピーする xlApp.Range("C10") = Me!起票日.Value xlApp.Range("H10") = Me!所属部門.Value xlApp.Range("P10") = Me!起票社員番号.Value xlApp.Range("T10") = Me!起票社員名.Value xlApp.Range("C17") = Me!対象システム.Value xlApp.Range("K17") = Me!処理区分.Value xlApp.Range("P17") = Me!対象画面.Value xlApp.Range("C21") = Me!改修内容.Value xlApp.Range("C38") = Me!回答日.Value xlApp.Range("I38") = Me!回答社員名.Value xlApp.Range("C43") = Me!回答内容.Value 'ファイル名に所属部門と回答日を付加する strSaveFile = "回答票_" & Me!所属部門 & "_" & Format(Me!起票日, "yyyymmdd") & ".xls" '名前を変更して保存 xlBook.SaveAs FileName:=strMDBPATH & strSaveFile 'テンプレートを終了 ' xlApp.Quit 'オブジェクトの開放 Set xlApp = Nothing Set xlBook = Nothing MsgBox "回答票を発行しました。", vbInformation Exit_コマンド0_Click: Exit Sub Err_コマンド0_Click: MsgBox Err.Description Resume Exit_コマンド0_Click End Sub

質問者が選んだベストアンサー

  • ベストアンサー
回答No.1

以前にも同じようなことを質問されていませんでしたか? http://okwave.jp/qa/q5857306.html 解決しませんでしたか? テンプレートなので、ファイルを直開きするのではなく、ワークブックの追加 >Set xlBook = xlApp.Workbooks.Open(Filename:=strXLSFILE, ReadOnly:=False) を Set xlBook = xlApp.Workbooks.Add(strXLSFILE) へ これではダメでした?

anman0201
質問者

お礼

ご回答ありがとうございます。 確かに前にも同じような質問していました。 間が空いてしまい忘れてしまいました。 無事解決できました。 ありがとうございます。

その他の回答 (1)

  • nda23
  • ベストアンサー率54% (777/1415)
回答No.2

保存した後で属性を変えてみては? xlBook.SaveAs FileName:=strMDBPATH & strSaveFile xlBook.Close '閉じないと変更できない SetAttr strMDBPATH & strSaveFile, vbArchive '変更

anman0201
質問者

お礼

ご回答ありがとうございます。 違う方法で解決しましたがこちらの意見も参考になりました。 またお願いします。

関連するQ&A

  • ACCESS2003のVBAで改修依頼管理ツールを作成しています。

    ACCESS2003のVBAで改修依頼管理ツールを作成しています。 そこで問題が発生してしまい行き詰っています。 問題は改修要望依頼が入ったテーブルを一覧表でEXCEL出力する際に、 2回目の出力を行うと「オブジェクト変数またはWithブロック変数が設定されていません。」 とエラー表示がされ、ここでデバックを使いなにも変更せず終了し、もう一回実行すると 今度は正常に出力されます。つまり正常出力した後にもう一回同じことをするとエラーが出るということです。 オブジェクトの開放もプロシージャの最後で行っているので環境は一回目の出力と変わらないはずなんですが、原因がわかりません。 常に「ActiveWorkbook.Sheets("Sheet1").Name = "改修依頼一覧"」の箇所でとまるので EXCELアプリケーションの参照が曖昧になっているのでしょうか? 下記はコード一部です。どこに問題があるでしょうか? 参照設定は編集済みです。 '【定数設定】 Const QName As String = "Q_改修依頼内容" '【変数設定】 Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim xlApp As Object Dim xlBook As Object Dim xlSheet As Object Dim i As Long Dim strMDBPATH As String 'MDBの保存場所、フォルダー・ディレクトリ Dim strXLSFILE As String 'テンプレートファイルの名前、e:\xxx\yyyy\テンプレート.xls Dim strSaveFile As String Dim ans As Long Dim strMsg As String Dim endCol As String '変数にエクセルアプリケーションをセットして開く Set xlApp = CreateObject("Excel.Application") ' Set xlBook = xlApp.Workbooks.Open(strXLSFILE) ' Set xlSheet = xlBook.Worksheets("Sheet1") ' xlApp.Visible = True With xlApp .Workbooks.Add .Visible = True End With   ActiveWorkbook.Sheets("Sheet1").Name = "改修依頼一覧" 'エラー発生箇所 Set cn = CurrentProject.Connection rs.Open QName, cn, adOpenKeyset, adLockReadOnly ActiveWorkbook.Sheets("改修依頼一覧").Range("A2").CopyFromRecordset rs 'A1セルを選択 Worksheets("改修依頼一覧").Cells(1, 1).Select 'ファイル名を設定 strSaveFile = "改修依頼内容一覧_" & Format(Now, "yyyymmdd_hhmmss") & ".xls" '名前を変更して保存 ActiveWorkbook.SaveAs FileName:=strMDBPATH & strSaveFile 'データ一覧画面に戻る DoCmd.SelectObject acForm, "データ一覧画面" 'オブジェクトの開放 Set xlApp = Nothing Set xlBook = Nothing Set xlSheet = Nothing Set rs = Nothing Set cn = Nothing Exit Sub 以上です。 編集モジュールなどはエラーに関係ないと思われるステートメントは省略させていただきました。 どなたかご存知の方がいればアドバイスお願いします。

  • ACCESSのVBAでテンプレとなるxlsファイルを開き、編集を完了し

    ACCESSのVBAでテンプレとなるxlsファイルを開き、編集を完了してSaveAsメソッドで違う名前で保存したいのですが、以下のコーディングではパス名が存在しないor別プログラムで開かれているなどとエラーメッセージが表示されます。どこがいけないのでしょうか?   Dim oApp As Object Dim xlBook As Object Dim strWORK As String Dim i As Integer Dim strMDBPATH As String Dim strXLSFILE As String Dim strSaveFile As String 'Accessの起動位置を取得 strWORK = CurrentDb.Name '後ろから1文字単位で¥を探す For i = Len(strWORK) To 1 Step -1 If Mid(strWORK, i, 1) = "\" Then Exit For '¥だったら抜ける Next i 'D:\xxxx\yyyy\zzz.mdb --> D:\xxxx\yyyy\ にする strMDBPATH = Mid(strWORK, 1, i) 'Excelの元ファイルの名前を作成 D:\xxxx\yyyy\ + テンプレート.xls strXLSFILE = strMDBPATH & "回答票テンプレ.xls" Set oApp = CreateObject("Excel.Application") Set xlBook = oApp.Workbooks.Open(strXLSFILE) oApp.Visible = True 'Only XL 97 supports UserControl Property ' On Error Resume Next ' oApp.UserControl = True '回答票テンプレを開く ' oApp.Workbooks.Open FileName:=strXLSFILE oApp.Range("C10") = Me!起票日.Value oApp.Range("H10") = Me!所属部門.Value oApp.Range("P10") = Me!起票社員番号.Value oApp.Range("T10") = Me!起票社員名.Value oApp.Range("C17") = Me!対象システム.Value oApp.Range("K17") = Me!処理区分.Value oApp.Range("P17") = Me!対象画面.Value oApp.Range("C21") = Me!改修内容.Value oApp.Range("C38") = Me!回答日.Value oApp.Range("I38") = Me!回答社員名.Value oApp.Range("C43") = Me!回答内容.Value strSaveFile = Me!所属部門 & "_" & Me!起票日 & ".xls" xlBook.SaveAs FileName:=strMDBPATH & strSaveFile

  • VB2008 エクセル出力

    VB2008 エクセル出力 教えていただけると助かります VB6.0使用時にエクセル出力をするために下記のようなプログラムで出力していました ※「Microsoft Excel 9.0 Object Library」を参照 Dim xlApp As EXCEL.Application Dim xlBook As EXCEL.Workbook Dim xlsheet As EXCEL.Worksheet Dim File As String File = App.Path + "\EXCEL\" + "フォーム.xls" Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Open(File) Set xlsheet = xlBook.Worksheets("テスト") xlsheet.Range("A1") = "テスト" 'フォルダ作成 If Dir("D:\", vbDirectory) = "" Then Call Mkdirs("D:\テスト") 'Worksheetを名前をつけて保存します。 xlApp.DisplayAlerts = False xlsheet.SaveAs "D:\テスト\テスト.xls" xlApp.Quit Set xlApp = Nothing Set xlBook = Nothing Set xlsheet = Nothing VB2008の場合だとどのように書けば同じように動きますか ※色々試してみましたがダメでした 「Microsoft Excel 12.0 Object Library」を参照しています

  • VBからエクセルを起動。そのあとエクセルを終了

    教えてください。 VBからエクセルを起動します。 そのあと、エクセルのシートの上にデータを貼り付けます。そして、エクセルを終了します。 しかし、エクセルが終了しません。 タスクバー上のエクセルをクリックすると終了します。 どうして、このような現象が起こるのかわかりません。 教えてください。 下記に同様のサンプルを書きました 誤記入があるかも知れませんが このような感じのプログラムです。 以上、よろしくお願いします。 public sub test Dim XApp as Excel.Application Dim nfilename as string Dim xlBook As Object Dim xlSheet As Object ' エクセルを起動 Set xlApp = New Excel.Application nfilename ="AAAA.xls" ' 指定されたファイルを開く Call xlApp.Workbooks.Open(nfilename) Set xlBook = xlApp.ActiveWorkbook Set xlSheet = xlBook.Worksheets(1) 'フォームを貼り付ける xlSheet.Range("a1").PasteSpecial      'ファイル名の作成 Filename="BBBB.xls" '保存 ChDir "C:\" xlBook.SaveAs Filename:=Filename,FileFormat:=xlNormal, _ Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _ CreateBackup:=False Set xlSheet = Nothing xlBook.Close True Set xlBook = Nothing xlApp.Quit Set xlApp = Nothing End sub

  • 開いているXLSファイルが読み取り専用か調べる

    Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Open("C:\test.xls") Set xlSheet = xlBook.Worksheets(1) 開いたExcelファイルが読み取り専用になっているかどうかを調べるにはどうすればいいですか? ファイルの属性が読み取り専用かどうかは取得できるのですが、属性は読み取り専用ではなくても誰か他のユーザーがネットワークから開いているために読み取り専用で開いている場合もわかるようにしたいです。 お願いします。

  • エクセルの開放

    VB2008でエクセルを操作しているのですが、エクセルのプロセスが残ってしまってどうやって解放すればいいのかわかりません。 サンプルプログラム-------------- Dim xlApp As New Excel.Application Dim xlBooks As Excel.Workbooks = xlApp.Workbooks Dim xlBook As Excel.Workbook = xlBooks.Add Dim xlSheets As Excel.Sheets = xlBook.Worksheets Dim xlSheet As Excel.Worksheet = xlSheets.Item(1) Dim xlobj As Object '開放用 xlobj = xlSheet.Range("A1:C3") xlobj.Value = "TEST" MRComObject(xlobj) MRComObject(xlSheet) MRComObject(xlSheets) xlBook.Close(False) MRComObject(xlBook) MRComObject(xlBooks) xlApp.Quit() MRComObject(xlApp) MRComObjectでCOM オブジェクトへの参照を解放しています。 このプログラムでは特に問題ないのですが、 xlobj = xlApp.Worksheets("Sheet2") xlobj2 = xlobj.Range("A1:C2") xlobj2.Value = "TEST" のようにワークシートを指定すると解放できません。 xlSheet = xlBook.Worksheets("Sheet2") としてもプロセスが残ります。 またVB6.0では可能だった xlApp.Worksheets("Sheet2").Select() のようにワークシートを切り替えるときもVB2008ではプロセスが残ってしまいます。 これはどのようにしたら解決するのでしょうか?

  • ACCESSからExcel操作

    アクセスのクエリーにて作成したデーターをエクセルにインポートをしてその後直接アクセス上から条件を入れてオートフィルターを掛け、条件にあったデーターのみセルに色をつけたいのですがオートフィルターで絞った後の処理がうまく出来ません。 Dim DB As DAO.Database Dim xlApp As Object Dim xlbook As Object Dim xlsheet As Object Dim strXlsS As String Dim strExSheet As String   インポート処理はOK   ここからアクセス上で操作をしたい。 strXlsS = "ファイル名フルパス" strExSheet = "シート名" Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True 'エクセル可視、不可視選択 Set xlbook = xlApp.workbooks.Open(strXlsS) Set xlsheet = xlbook.worksheets(strExSheet) xlsheet.Range("A1").Select xlsheet.Range("A1").AutoFilter xlsheet.Range("A1").AutoFilter Field:=8,Criteria1:="条件" ここまでは出来ました。 この後エクセル上では Range("A1:J37").Select と言う感じで選択するのですが、ここをどの様にやれば良いか教えて欲しいのです。 色々と検索をして SpecialCells を使う事までは解かり xlsheet.AutoFilter Range.Columns(1).SpecialCells(xlCellTypeVisible) とやってみたのですが 実行時エラー'424': オブジェクトが必要です。 とエラーになってしまいます。 参考先でもなんでも良いので宜しく御願いします。

  • SETを使ったほうがよい?

    accwessからエクセルファイルを開きたいのですが、 App.Workbooks.Open と、 Set xlBook = xlApp.Workbooks.Open とどちらを使った方がいいのでしょうか? ////////////////////////////////////////////////////////// Private Sub ファイル1_Click() Dim App As Object Dim MyFileName As String MyFileName = "D:\My Documents\test.xls" Set App = CreateObject("Excel.Application") App.Workbooks.Open FileName:=MyFileName App.Visible = True End Sub でも Private Sub ファイル2_Click() Dim xlApp As Object Dim xlBook As Object Dim FileName As String Const FolderName = "D:\My Documents\test.xls" Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Open(FolderName & FileName) xlApp.Visible = True Set xlApp = Nothing Set xlBook = Nothing End Sub ////////////////////////////////////////////////////////// でも開けました。 多分、SETを使うかどうかの違いだと思うのですが VBAでコードを作る際、どちらのコードを使った方がいいか教えてください。

  • EXCEL VBA Applicationインスタンス内での範囲指定

    Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Private Const SCol = 1 Private Const SRow = 1 Private Const ECol = 1 Private Const ERow = 1 Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Add xlBook.Sheets("Sheet1").Range("A1") = 1 xlBook.Sheets("Sheet1").Range(Cells(SCol,SRow), Cells(ECol, ERow)).Borders.LineStyle = True xlBook.SaveAs "c:\ss.xls" xlBook.Close xlApp.Quit Set xlApp = Nothing Set xlBook = Nothing 以上のようにEXCEL VBA内で新規ExcelApplicationインスタンス内で値を代入し、線を引いているのですが線を引く範囲指定部分でアプリケーション定義またはオブジェクト定義のエラーですと表示されます。 xlBook.Sheets("Sheet1").Range("A1:B2").Borders.LineStyle = True ↑のような形であればエラーは出ません。 xlBook.Sheets("Sheet1").Range(Cells(1,1),Cells(2,2)).Borders.LineStyle = True ↑ではエラーが出ます。 新規ExcelApplicationインスタンス内でのRange(Cells)の使用方法が違うのでしょうか?よろしくお願いします。

  • CreateObject関数 引数にパスワード

    CreateObject関数を使ってエクセルを開く際に、 引数にパスワードを設定することは可能ですか? 新規Microsoft Excel ワークシート.xlsと言うファイルには、 読み足りパスワードとして0000と言うパスワードが設定されているのですが Sub Sample() Dim MyPath As String Dim MyFile As String Dim xlApp As Object Dim xlBook As Object MyPath = "C:\" MyFile = "新規Microsoft Excel ワークシート.xls" Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Open(MyPath & MyFile) xlApp.Visible = True Set xlApp = Nothing Set xlBook = Nothing End Sub このようなvbaコードで開く時に、 どうやってパスワードを設定すればいいでしょうか? Set xlBook = xlApp.Workbooks.Open(MyPath & MyFile),"0000" こうすると構文エラーになります。 Sub Sample02() Dim MyPath As String Dim MyFile As String MyPath = "C:\" MyFile = "新規Microsoft Excel ワークシート.xls" Workbooks.Open Filename:=MyPath & MyFile, Password:="0000" End Sub これのCreateObjectバージョンが知りたいです。

専門家に質問してみよう