Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


2561 / 13646 ツリー ←次へ | 前へ→

【67226】エクセルからアクセスデータを取込方法 まい 10/11/16(火) 11:53 質問[未読]
【67227】Re:エクセルからアクセスデータを取込方法 Jaka 10/11/16(火) 13:07 発言[未読]
【67242】Re:エクセルからアクセスデータを取込方法 まい 10/11/17(水) 13:05 お礼[未読]
【67245】ごめんなさい。コードが抜けてました。 Jaka 10/11/17(水) 13:28 発言[未読]
【67228】Re:エクセルからアクセスデータを取込方法 Yuki 10/11/16(火) 15:57 発言[未読]
【67230】Re:エクセルからアクセスデータを取込方法 かみちゃん 10/11/16(火) 20:03 発言[未読]
【67237】Re:エクセルからアクセスデータを取込方法 Yuki 10/11/17(水) 9:37 発言[未読]
【67244】Re:エクセルからアクセスデータを取込方法 まい 10/11/17(水) 13:09 お礼[未読]
【67243】Re:エクセルからアクセスデータを取込方法 まい 10/11/17(水) 13:07 お礼[未読]

【67226】エクセルからアクセスデータを取込方法
質問  まい  - 10/11/16(火) 11:53 -

引用なし
パスワード
   エクセルから、VBAを使って、
アクセスのテーブルデータを取り込むマクロを作成していますが、
項目が入ってきません

項目も取り込むようにするにはどうしたら、よいのでしょうか?

どうか、アドバイスをお願いします

現在の記述です↓

Sub Access取込()

Dim cn As Connection
Dim rs As Recordset

Worksheets.Add after:=Worksheets(Worksheets.Count)
 ActiveSheet.Name = "シート1"

Set cn = New Connection
         
cn.ConnectionString = "Provider=microsoft.jet.oledb.4.0;" _
          & "data source=C:\フォルダ\データ.mdb"
          
cn.Open

Set rs = New Recordset
rs.Open "T_test", cn

Sheets("シート1").Range("A" & Rows.Count).End(xlUp).Offset(1).CopyFromRecordset rs

rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing


End Sub

【67227】Re:エクセルからアクセスデータを取込方法
発言  Jaka  - 10/11/16(火) 13:07 -

引用なし
パスワード
   1人よがりですみません。
今までmdbファイルを触った事がなかったのですが、触っておいた方がいいだろうと、
1月〜4月に少し手を出して見たやつです。

DAOを使いました。
ADO...なんのこっちゃが、面倒くさいので今も変わらず。

参照設定
MIcrosoft DAO ?.? Object Loibrary
のチェックが必要。


ユーザーフォームレイアウト
コントロール計4つ。

 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 "データが1件もない。"
   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

【67228】Re:エクセルからアクセスデータを取込方法
発言  Yuki  - 10/11/16(火) 15:57 -

引用なし
パスワード
   ▼まい さん:
>項目も取り込むようにするにはどうしたら、よいのでしょうか?
>
>どうか、アドバイスをお願いします

Dim i as long
>
> Worksheets.Add after:=Worksheets(Worksheets.Count)
> ActiveSheet.Name = "シート1"
>
>Set cn = New Connection
>         
>cn.ConnectionString = "Provider=microsoft.jet.oledb.4.0;" _
>          & "data source=C:\フォルダ\データ.mdb"
>          
>cn.Open
>
>Set rs = New Recordset
>rs.Open "T_test", cn

for i 0 to rs.Fields.count - 1
   Sheets("シート1").cells(行, i).value = rs.Fields(i).name
next             '↑のiは桁の位置にあわせる。例えば i + 1とか      
>
>Sheets("シート1").Range("A" & Rows.Count).End(xlUp).Offset(1).CopyFromRecordset rs

【67230】Re:エクセルからアクセスデータを取込方法
発言  かみちゃん E-MAIL  - 10/11/16(火) 20:03 -

引用なし
パスワード
   こんにちは。かみちゃん です。

> for i 0 to rs.Fields.count - 1
>   Sheets("シート1").cells(行, i).value = rs.Fields(i).name
> next             '↑のiは桁の位置にあわせる。例えば i + 1とか      

少なくとも以下のようにしないといけないと思います。

For i = 0 To rs.Fields.Count - 1
'  ^^^
 Sheets("シート1").Cells(行, i + 1).Value = rs.Fields(i).Name
'               ^^^^
Next             '↑のiは桁の位置にあわせる。例えば i + 1とか

あと、本題と少しはずれるかもしれませんが、以下なども参考になると思います。
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_130_030.html

【67237】Re:エクセルからアクセスデータを取込方法
発言  Yuki  - 10/11/17(水) 9:37 -

引用なし
パスワード
   ▼かみちゃん さん:
>少なくとも以下のようにしないといけないと思います。
>
>For i = 0 To rs.Fields.Count - 1

お恥ずかしい確認せずにUPしました。

【67242】Re:エクセルからアクセスデータを取込方法
お礼  まい  - 10/11/17(水) 13:05 -

引用なし
パスワード
   ▼Jaka さん:

ありがとうございます

まだ解読中ですが、こちらの記述方法試してみたいと思います

【67243】Re:エクセルからアクセスデータを取込方法
お礼  まい  - 10/11/17(水) 13:07 -

引用なし
パスワード
   ▼Yuki さん:

ありがとうございます
早速下記記述を試してみたところうまくいきました
たすかりました

>
> for i 0 to rs.Fields.count - 1
>   Sheets("シート1").cells(行, i).value = rs.Fields(i).name
> next             '↑のiは桁の位置にあわせる。例えば i + 1とか

【67244】Re:エクセルからアクセスデータを取込方法
お礼  まい  - 10/11/17(水) 13:09 -

引用なし
パスワード
   ▼かみちゃん さん:

アドバイスありがとうございました
下のアドレスも参考にしていきたいと思います

>
>あと、本題と少しはずれるかもしれませんが、以下なども参考になると思います。
>http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_130_030.html

【67245】ごめんなさい。コードが抜けてました。
発言  Jaka  - 10/11/17(水) 13:28 -

引用なし
パスワード
   すみません。
貼り付け忘れていた物がありました。

全て標準モジュール

Function TBLName_dist(Dbs As DAO.Database) As Variant
  Dim TB() As String, i As Long, ii As Long
  For i = 0 To Dbs.TableDefs.Count - 1
    If Left(Dbs.TableDefs(i).Name, 4) <> "MSys" Then
     ii = ii + 1
     ReDim Preserve TB(1 To ii)
     TB(ii) = Dbs.TableDefs(i).Name
    End If
  Next i
  If ii = 0 Then
   TBLName_dist = Empty
  Else
   TBLName_dist = TB
  End If
End Function


Function TBLE選択(TbNm_F As Variant) As String
  Dim List_Tb() As String, i As Long
  Dim TbTb As Variant, No As Long

  For i = 1 To UBound(TbNm_F)
    If Left(TbNm_F(i), 4) <> "MSys" Then
     No = No + 1
     ReDim Preserve List_Tb(1 To No)
     List_Tb(No) = TbNm_F(i)
    End If
  Next

  With UserForm1
    .ListBox1.List = List_Tb
    .Show
    If .ListBox1.ListIndex >= 0 Then
     TBLE選択 = .ListBox1.List(.ListBox1.ListIndex)
    Else
     TBLE選択 = Empty
    End If
    'Unload .ListBox1.Parent
  End With
End Function

2561 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free