Excel VBA質問箱 IV

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

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


19390 / 76732 ←次へ | 前へ→

【62775】ExcelからAccessへデータ受け渡し
質問  どらちゃん  - 09/8/31(月) 19:58 -

引用なし
パスワード
   お世話になります。

時系列で並んでいるExcelのデータのうち、ある一日のデータのみをアクセスへEXPORTしたいのですが、EXCELの項目名とAccessのフィールド名が同じものだけEXPORTするようにしたいのです。deleteまではスムーズですが、その後のどこをどういう風に直したらいいかわからなくなってしまいました。
教えていただけませんでしょうか。

<EXCEL>
      B   C   E
2009/8/1 さんま あじ いわし



<Access>
      A   B   C   D   E
2009/8/1    さんま あじ     いわし

-------------

Dim CBk As Workbook
Dim CSht As Worksheet
Dim Cr As Byte: Dim Col As Byte

Public Sub Port_Export()
  Dim myDb As DAO.Database
  Dim myRst As DAO.Recordset
  Dim myFileName As String:   Dim myTblsql As String:   Dim myTbl As String
  Dim dt As Date
  Dim fld As Long

  Set CBk = ThisWorkbook: Set CSht = CBk.ActiveSheet
  dt = CSht.Cells(2, 1).Value
   
  Select Case CBk.ActiveSheet.Name
    Case "Pr": myTbl = "Daily"
    Case "Bg": myTbl = "Ind"
  End Select
 
  myFileName = "test.mdb"
  myTblsql = "delete * FROM " & myTbl & " WHERE " & myTbl & ".date in(#" & dt & "#)"
  
  Set myDb = OpenDatabase(CBk.Path & "\" & myFileName)
  myDb.Execute myTblsql
  
  Set myRst = myDb.OpenRecordset(myTbl, dbOpenDynaset)
  Cr = 8: Col = 17
  myRst.AddNew
  ct = 17
  Do Until CSht.Cells(Cr, 17) = ""
    If CSht.Cells(Cr, 17) = dt Then
      Do Until CSht.Cells(Cr, Col) = ""
        For fld = 0 To myRst.Fields.Count - 1
          If myRst(fld).Name = CSht.Cells(7, ct) Then
          With myRst
            .Fields(fld) = CSht.Cells(Cr, Col)
            .Update
          End With
          ct = ct + 1
          End If
        Next
      Loop
    End If
    Cr = Cr + 1
  Loop
   
  myDb.Close
  Set myRst = Nothing
  Set myDb = Nothing
End Sub
0 hits

【62775】ExcelからAccessへデータ受け渡し どらちゃん 09/8/31(月) 19:58 質問
【62776】Re:ExcelからAccessへデータ受け渡し neptune 09/8/31(月) 23:02 発言
【62779】Re:ExcelからAccessへデータ受け渡し どらちゃん 09/9/1(火) 6:13 発言
【62780】Re:ExcelからAccessへデータ受け渡し どらちゃん 09/9/1(火) 12:34 質問
【62781】Re:ExcelからAccessへデータ受け渡し Yuki 09/9/1(火) 13:59 発言
【62783】Re:ExcelからAccessへデータ受け渡し どらちゃん 09/9/1(火) 15:30 質問
【62784】Re:ExcelからAccessへデータ受け渡し Yuki 09/9/1(火) 15:44 発言
【62793】Re:ExcelからAccessへデータ受け渡し Yuki 09/9/2(水) 7:20 発言
【62795】Re:ExcelからAccessへデータ受け渡し どらちゃん 09/9/2(水) 20:30 質問
【62799】Re:ExcelからAccessへデータ受け渡し Yuki 09/9/3(木) 8:52 発言
【62800】Re:ExcelからAccessへデータ受け渡し どらちゃん 09/9/3(木) 10:01 質問
【62801】Re:ExcelからAccessへデータ受け渡し Yuki 09/9/3(木) 12:23 発言
【62804】Re:ExcelからAccessへデータ受け渡し どらちゃん 09/9/3(木) 19:21 お礼
【62782】Re:ExcelからAccessへデータ受け渡し neptune 09/9/1(火) 14:42 発言
【62786】Re:ExcelからAccessへデータ受け渡し どらちゃん 09/9/1(火) 21:00 発言
【62789】Re:ExcelからAccessへデータ受け渡し neptune 09/9/1(火) 22:18 発言

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