• ベストアンサー

アクセステーブルがあれば削除VBA

win10 office365 access365におきまして テーブル　この例ではTMPがあれば　テーブルそのものを削除し （ですから削除クエリを使うこととは違うと思いましたが） はじめから存在しないときは次のコードに進む ということでほかの記事を参考に作ってみたのが Public Function tmpdelete() If funcTableExists("T_TMP") = True Then DoCmd.DeleteObject acTable, "T_TMP" End If End Function ----------------------- そもそもfuncTableExistsというのは 付属の関数ではないのかなと調べまして ----------------------- Private Function funcTableExists(ByVal strTableName As String) As Boolean Dim db As Database Dim tdf As TableDef Set db = CurrentDb For Each tdf In db.TableDefs If (T_TMP= strTableName) Then funcTableExist = True Exit Function End If Next tdf Set tdf = Nothing db.Close Set db = Nothing End Function --------------------- If (T_TMP= strTableName) Then ここに削除判定の対象のテーブル名を入れましたが 上記いずれも 作動しません マクロのプロシージャで組み入れたいので subでばく　functionで書くようにとありましたので 上記のようにしました また　すみません 宜しくお願い致します

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

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1615/2454)
回答No.2

補足です。 T_TMPが開いているとエラーになりますから、削除の前に閉じるコードを記載しておいた方がいいと思います。 あと蛇足です。 > If (T_TMP = strTableName) Then 変数宣言を強制していれば上記は変数が定義されていないというエラーになります。 強制していなければT_TMPは変数として扱われますから何も代入されてなくカラの状態で funcTableExists("T_TMP") で呼び出された場合、strTableNameの中身は文字列"T_TMP"ですから If (T_TMP = strTableName) Then は If (""="T_TMP") Then は不一致となりなにもおこりません。 で If ("T_TMP" = strTableName) Then もしこうなっていればこのIF文は funcTableExists("T_TMP") で呼び出される限り一致となり T_TMPがあってもなくても DoCmd.DeleteObject acTable, "T_TMP" が実行されます。

sushidokei
質問者

お礼

追加コメントも有り難うございました。削除の前に閉じるコード　こちらも作れて大丈夫でした　1と2との回答を合わせて作り直し、意味も理解できたうえで稼働しました。有り難うございました。

Powered by GRATICA

その他の回答 (1)

  • kkkkkm
  • ベストアンサー率65% (1615/2454)
回答No.1

> If (T_TMP= strTableName) Then strTableNameは funcTableExists(ByVal strTableName As String) の引数ですので If funcTableExists("T_TMP") = True Then で "T_TMP" が入っています。 ですので、総当たりで見ているテーブルの名前(tdf.Name)と引数の値(T_TMP)が一致するかどうかの判断をしてください。 funcTableExist = True はsが抜けていますので funcTableExists = True 以下のように変更して試してみてください。 For Each tdf In db.TableDefs If (tdf.Name = strTableName) Then funcTableExists = True Exit Function End If Next tdf

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. Access（アクセス）

関連するQ&A

  • アクセスのＶＢＡでテキストデータのリンクを更新したいのですが

    コードは以下ですが、リンクの更新がうまくいかず更新されずに終了 してしまいます。 Function RefreshLinks(strFileName As String) As Boolean '指定されたデータベースへのリンクを更新します。更新に成功した場合は、True を返します。 Dim dbs As Database Dim intCount As Integer Dim tdf As TableDef 'データベースの全てのテーブルをループします。 Set dbs = CurrentDb For intCount = 0 To dbs.TableDefs.Count - 1 Set tdf = dbs.TableDefs(intCount) 'tdf.connectがある場合、それはリンクテーブルです。 If Len(tdf.Connect) > 0 Then tdf.Connect = "text;databese=" & strFileName Err = 0 On Error Resume Next tdf.RefreshLink 'テーブルのリンクを更新します。 If Err <> 0 Then RefreshLinks = False Exit Function End If End If Next intCount RefreshLinks = True 'リンクの更新が完了しました。 End Function

  • Access VBA 削除

    またお世話になります。 Access2003を使用しています。 不要になったアカウントを削除できるようなものを作成したいのですがうまくいきません。 リストボックスに表示されたアカウントを選択し、 ボタンを押すとテーブルから削除できるというものを考えています。 テーブル名：　tbl_ユーザー フィールド名：　ユーザー名　パスワード　アカウント フォーム名：　frm_Account_Delete 　リストボックス：　UserList 　コマンドボタン：　Del いろいろ調べて自分なりに作ってみたのですがエラーが出てしまいました。 ―――以下VBAコード――― Dim db As Database Dim rs As DAO.Recordset Set db = CurrentDb() Set rs = db.OpenRecordset("tbl_ユーザー") If IsNull(UserList) Then MsgBox "削除するアカウントを選択してください" Else If MsgBox(UserList & "を削除しますか？", vbYesNo) = vbYes Then db.TableDefs.delete UserList　　　　 MsgBox "UserListを削除しました。" End If End If rs.Close db.Close Set db = Nothing ―――以上――― これだと”このコレクションには項目がありません”というエラーが出ます。 アドバイスをよろしくお願いします。

  • アクセスＶＢＡです

    Sub test() Dim DB As Database Dim T As TableDef Dim myTable As String myTable = "Table1" Set DB = OpenDatabase(CurrentProject.FullName) For Each T In DB.TableDefs If T.Name = myTable Then DoCmd.DeleteObject acTable, myTable Exit For End If Next DB.Close Set DB = Nothing End Sub これを実行しようとすると Dim DB As Database の部分で コンパイルエラー プロジェクトではなく、ユーザ定義型を指定してください。 と言うエラーになります。 Dim DB As Objectにすればエラーにならずに進みますが 何が原因なのでしょうか？

  • アクセス　テーブルデータ他のテーブルにコピーVBA

    win10 access365のmdbファイルにおいて table1のフィールド1がID　数値型　長整数型 値要求あり　重複あり フィールド2が氏名　短いテキスト型　225 値要求なし　重複あり　 table2；フィールド1がID　数値型　長整数型 値要求あり　重複あり フィールド2が氏名　短いテキスト型　225 値要求なし　重複あり　 上記に置いて table2の新しいデータとして table1のデータをコピーしたい、 ただしtable1には　レコードは１行だけとします （table1にレコードが複数行ある場合の最新レコードだけtable2にコピーも出来れば知りたいです） アクセス付属の更新クエリーでは、どうも　うまくいきません ｓｑｌにおいて UPDATE table1, table2 SET table2.ID = [table1]![ID], table2.氏名 = [table1]![氏名]; 上記動作しません Function table1から2() Dim db As DAO.Database Dim rst As Recordset Dim TB As Table Dim Rdset As Recordset On Error Resume Next Set db = DBEngine(0)(0) Set Rdset = db.OpenRecordset("table2", DB_OPEN_TABLE) Rdset.AddNew Rdset![ID] = Table![table1]![ID] Rdset![氏名] = Table![table1]![氏名] Rdset.Update End Function table1, table2を　それぞれ 同名のフォームを作り Function table1から2() Dim db As DAO.Database Dim rst As Recordset Dim fm As Form Dim Rdset As Recordset On Error Resume Next Set db = DBEngine(0)(0) Set fm = Forms![table1] If Rdset.BOF Then Exit Function Else Set Rdset = db.OpenRecordset("table2", DB_OPEN_TABLE) Rdset.AddNew Rdset![ID] = Forms![table1]![ID] Rdset![氏名] = Forms![table1]![氏名] Rdset.Update End If End Function いずれも table2のデータ更新が　なされていません すみません 宜しくお願い致します

  • Access 外部MDBのリンクテーブルの変更

    お世話になってます。 Access2007へ移行のため、移行用のmdbを作成し、移行する既存のmdb群のMSysObjectsを変更しようとしています。 以下のようにVBAで自分のリンクテーブルの接続パスワードは変更できたのですが、同じく他のMDBを指定してリンクテーブルを変更する事は出来るでしょうか？ Dim dbs As DAO.Database Dim tdf As DAO.TableDef Set dbs = CurrentDb For Each tdf In dbs.Tabledefs 　　If Len(tdf.Connect > 0 Then 　　　　tdf.Connect=";PWD=" & strPWD 　'←リンクテーブルの接続PWDの変更 　　　　tdf.RefreshLink 　　End If Next よろしくお願い致します。

  • アクセス　リンク先のバックアップテーブル削除

    お世話になっております。 以前、リンク先DBでリンクテーブルのバックアップをとり、 同じ名称のテーブルがあったら処理しない というVBAを教えていただいたのですが・・・ そこに付随して質問です。 Dim appAccess As Access.Application Set appAccess = CreateObject("Access.Application") With appAccess .OpenCurrentDatabase strLinkDB If numHantei = 1 Then .DoCmd.TransferDatabase acImport, "Microsoft Access", _ strLinkDB, acTable, "T_権限情報", "BK_テーブル1_" & Format(Date, "yymmdd") .DoCmd.TransferDatabase acImport, "Microsoft Access", _ strLinkDB, acTable, "T_社員情報", "BK_テーブル2_" & Format(Date, "yymmdd") End If .Quit End With Set appAccess = Nothing 7日以上経過したバックアップファイルを削除するには （DoCmd.DeleteObject acTableを使って削除になるかと思いますが）、 実際、どのようにしたら可能でしょうか。 初心者につき、ご教示いただけると幸いです。 よろしくお願い致します。

  • リンク元のパスを変更したい　vba　　アクセス

    アクセスです。 該当する複数のテーブルの、リンク元のパスを変更したいのですが Sub Sample() Dim DB As Database Dim T As TableDef Dim mystr As String Set DB = OpenDatabase(CurrentProject.FullName) For Each T In DB.TableDefs mystr = CurrentDb.TableDefs(T.Name).Connect If mystr Like "*\\該当のパス*" Then Debug.Print T.Name Debug.Print CurrentDb.TableDefs(T.Name).Connect 　’自分としてはこれで変更できると思った CurrentDb.TableDefs(T.Name).Connect = _ ";DATABASE=C:\新たなパス\○○.accdb" Debug.Print CurrentDb.TableDefs(T.Name).Connect End If Next DB.Close Set DB = Nothing End Sub を実行してもエラーにもならないし、リンクテーブルのパスも変わりません。 CurrentDb.TableDefs(T.Name).Connect はパスの取得しかできないのでしょうか？ パスを設定する方法を教えてください。 よろしくお願いします。

  • Access VBAについて教えて下さい。

    Access VBAについて教えて下さい。 <内容> 選択ボタンを押下するとファイル選択のダイアログ画面が表示されます。 そこから複数ファイルを選択してテキストボックスに選択したファイルを取得します。 実行ボタンを押下するとテキストボックスで取得したファイルを同じテーブルにインポートします。 ※テキストボックスの名前 ＝ FileList <VBA> Private Sub 選択_Click() With Application.FileDialog(msoFileDialogFilePicker) .Filters.Clear .Title = "ファイル選択" .Filters.Add "すべてのファイル", "*.*" .Filters.Add "テキストファイル", "*.txt" .Filters.Add "TSVファイル", "*.tsv" .Filters.Add "EXCELファイル", "*.xls" .AllowMultiSelect = True .InitialFileName = CurrentProject.Path If .Show = -1 Then Me.FileList = .SelectedItems(1) 'ユーザーが [キャンセル] をクリックした場合 Else End If End With End　Sub Private Sub 実行_Click() 'テーブル削除 On Error GoTo エラー Dim mySQL As String Dim strName As String Dim strmsg As String Set Db = CurrentDb strName = "テスト" strmsg = "" & strName & "テーブルを削除します。" mySQL = "DROP TABLE " & strName '「はい」ボタンを押下した場合 If MsgBox(strmsg, vbYesNo) = vbYes Then Db.Execute mySQL MsgBox strName & "テーブルを削除しました。", vbCritical MsgBox "インポートします。", vbInformation 'インポート開始 DoCmd.TransferSpreadsheet aclmport, acSpreadsheetTypeExcel8, "テスト", FileList, True MsgBox "インポート完了", vbInformation '「いいえ」ボタンを押下した場合 End If Db.Close: Set Db = Nothing Exit Sub 'テーブルが存在しなかった場合 エラー: MsgBox strName & "テーブルが存在しません。", vbExclamation MsgBox "インポートします。", vbInformation 'インポート開始 DoCmd.TransferSpreadsheet aclmport, acSpreadsheetTypeExcel8, "テスト", FileList, True MsgBox "インポート完了", vbInformation End Sub <困っていること> ファイルを複数選択することは、出来ますがテキストボックスには1ファイルしか取得出来ません。 そのため、インポートも1ファイルのみになってしまいます。 どのようにしたらテキストボックスに複数ファイル名を取得し、インポート出来るのでしょうか？

  • ACCESSのCSV出力に関して

    教えて下さい。 ACCESSであるテーブルのデータをCSV出力しようとして、以下のような記述をしました。 結果、問題なく出力されましたが、データだけでなく、項目も出力しようと考えています。 その際にはどのような記述をすれば良いでしょうか？ 初歩的な質問で申し訳ありません。 教えて下さい。 《内容》 Dim cnn As ADODB.Connection Dim rst As ADODB.Recordset Dim stSQL As String Dim stTBL As String Dim myWSH As Object 'WScript Dim myDesktopPath As String Dim stPath As String 'フルパス Dim objFSO As Object 'FileSystemObject Dim fsoTS As Object 'TextStream Dim tmp As Variant 'データ Dim re As Variant 'データ件数 Dim stDocName As String Const ForAppending = 8 stTBL = "t_合算" 'テーブル名 '開始メッセージ stDocName = "「" & stTBL & ".CSV」 ファイルをデスクトップに作成します" If MsgBox(stDocName, vbYesNo) = vbNo Then Exit Sub 'デスクトップパス取得 Set myWSH = CreateObject("WScript.Shell") myDesktopPath = myWSH.SpecialFolders("Desktop") Set myWSH = Nothing 'フルパス stPath = myDesktopPath & "\" & stTBL & ".CSV" '読み取り専用でセット Set cnn = CurrentProject.Connection stSQL = "SELECT * FROM " & stTBL Set rst = cnn.Execute(stSQL) If rst.EOF Then stDocName = "出力するデータがありませんでした" Else '文字列データ格納 (全データ出力、カンマ区切り) tmp = rst.GetString(adClipString, , ",", vbNewLine) '出力 Set objFSO = CreateObject("Scripting.FileSystemObject") With objFSO If .FileExists(stPath) Then '既存ファイル削除 Call .DeleteFile(stPath) End If Set fsoTS = .OpenTextFile(stPath, ForAppending, True) '文字列一括書き出し fsoTS.WriteLine tmp re = fsoTS.Line - 2 End With Set fsoTS = Nothing: Set objFSO = Nothing stDocName = re & " 件の CSVデータを出力しました。" End If MsgBox stDocName, vbOKOnly

  • Excel2010 VBA 条件色付け

    Sub sample() Dim r As Range For Each r In Range("q6:q30") If myIsNumeric(r) Then r.Offset(0, 1).Value = "数字" Else r.Offset(0, 1).Value = "文字" End If Next End Sub Function myIsNumeric(Target As Range) Dim r As Range Dim buf, tmp Dim flg As Boolean Dim i As Integer buf = Target For i = 1 To Len(buf) tmp = Mid(buf, i, 1) If IsNumeric(tmp) Then flg = True Exit For End If Next myIsNumeric = flg End Function を数字が入ってたら塗りつぶさないで、 数字が入ってなかったら塗りつぶすように直したいです。 あああ→塗る あああ1－1→塗らない 住所→塗る 住所12→塗らない

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する