| |
１人よがりですみません。
今までmdbファイルを触った事がなかったのですが、触っておいた方がいいだろうと、
１月〜４月に少し手を出して見たやつです。
DAOを使いました。
ADO...なんのこっちゃが、面倒くさいので今も変わらず。
参照設定
MIcrosoft DAO ?.? Object Loibrary
のチェックが必要。
ユーザーフォームレイアウト
コントロール計４つ。
Label1
「表示したいテーブルを選んで、
OKボタンを押してください。」
ListBox1
CommandButton2 CommandButton1
フォームモジュール
Private Sub CommandButton1_Click()
If Me.ListBox1.ListIndex = -1 Then
'Me.Caption = "中止"
MsgBox "テーブルが選択されてません。", vbExclamation, "リスト未選択。"
Exit Sub
End If
Me.Hide
End Sub
Private Sub CommandButton2_Click()
Me.Caption = "中止"
Me.Hide
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then
Me.ListBox1.ListIndex = -1
Me.Caption = "中止"
Cancel = True
Me.Hide
End If
End Sub
標準モジュール
Sub mdb読み込み2()
Dim Dbs As DAO.Database, i As Long, Rw As Long
Dim Tbl As DAO.Recordset
Dim Newmdb_F As String, TbNm As Variant
Dim Readtb As Variant
Dim Data_F As Variant
Dim FildCt As Long
Dim TbFlNm As Variant
Dim Stime As Variant
Dim 書出しセル As String
'Data_F = ThisWorkbook.Path & "\" & "新規mdb作成テスト.mdb"
Data_F = Application.GetOpenFilename("Excelファイル (*.mdb), *.mdb")
If Data_F = False Then
End
End If
Set Dbs = OpenDatabase(Data_F)
TbNm = TBLName_dist(Dbs)
If IsEmpty(TbNm) Then
MsgBox "テーブルがない？", vbExclamation
Dbs.Close
Set Dbs = Nothing
Close #FileNo
Exit Sub
ElseIf IsArray(TbNm) Then
' If UBound(TbNm) = 1 Then
' Readtb = TbNm(1)
' Else
Readtb = TBLE選択(TbNm)
If UserForm1.Caption = "中止" Then
Set Dbs = Nothing
Unload UserForm1
Exit Sub
End If
If IsEmpty(Readtb) Then
MsgBox "未選択、終了。", vbExclamation + vbOKOnly, "未選択"
Set Dbs = Nothing
Unload UserForm1
Exit Sub
End If
' End If
Else
a = 0
End If
Set Tbl = Dbs.OpenRecordset(Readtb, dbOpenTable)
'Set Tbl = Dbs.OpenRecordset("HATTYUSHO", dbOpenTable)
If Tbl.RecordCount < 1 Then
MsgBox "データが１件もない。"
Set Dbs = Nothing
Set Tbl = Nothing
Exit Sub
Else
'MsgBox Tbl.RecordCount & " 件のデータ数", vbInformation
End If
ActiveSheet.UsedRange.ClearContents
'フィールド名
If MsgBox("フィールド名（項目名）も出力しますか？", vbYesNo, _
"フィールド名の出力確認。") = vbYes Then
For i = 0 To Tbl.Fields.Count - 1
ActiveSheet.Cells(1, i + 1).Value = Tbl.Fields(i).Name
Next i
書出しセル = "A2"
Else
書出しセル = "A1"
End If
Stime = Now()
Range(書出しセル).CopyFromRecordset Tbl
Tbl.Close
Dbs.Close
Set Dbs = Nothing
Set Tbl = Nothing
MsgBox Format(Now() - Stime, "hh:mm:ss")
End Sub
|
|
Jaka
- 10/11/16(火) 13:07 -
