| |
こんばんは。
サンプルを考えてみました。
エクセルシートとアクセステーブルのフィールドが一致しているのが条件です。
エクセルの1行目が項目行（＝アクセスのフィールド名）
2行目以降にデータがあるものとします。
>Excel97からAccess97へDaoにより接続し、データを保存しています。
>（注文番号、お客様、工程、工程数量など）
>そこでExcelからAccessへデータを保存する場合、同一の注文番号がAccess側に
>データが存在するかどうか確認し、なければ保存し、あればデータの更新を
>するかどうかのメッセージが出るようにしたいのです。
以下標準モジュールに
Sub test01()
Const DATA_BASE_NAME As String = "I:\MDB\dbTest01.mdb"
Const TABLE_NAME As String = "acsTable01"
Dim myWS As Workspace
Dim myDB As Database
Dim myTable As Recordset
Dim myID As String
Dim i As Long, j As Long
Set myWS = DBEngine.Workspaces(0)
Set myDB = myWS.OpenDatabase(DATA_BASE_NAME)
Set myTable = myDB.OpenRecordset(TABLE_NAME, dbOpenDynaset)
With myTable
For i = 2 To Range("a65536").End(xlUp).Row
myID = Cells(i, 1).Value
.FindFirst "注文番号=" & myID
.Edit
If .NoMatch = False Then
If MsgBox("受注番号 " & myID & " が見つかりました" & _
Chr(10) & "データを更新しますか?", vbOKCancel) = vbOK Then
For j = 2 To Range("IV1").End(xlToLeft).Column
.Fields(j - 1) = Cells(i, j).Value
Next
End If
Else
.AddNew
For j = 1 To Range("IV1").End(xlToLeft).Column
.Fields(j - 1) = Cells(i, j).Value
Next
End If
.Update
Next
End With
myDB.Close
myWS.Close
End Sub
>
>今後作成する予定なのですがExcel側から注文番号でお客様を出せるように
>したいと考えています。こちらに関しても教えて頂けますでしょうか。
>
>勝手なことばかり言いますがよろしくお願いします。
A列に注文番号を入れると表示します
以下対象シートのモジュールに
Private Sub Worksheet_Change(ByVal Target As Range)
Const DATA_BASE_NAME As String = "I:\MDB\dbTest01.mdb"
Const TABLE_NAME As String = "acsTable01"
Dim myWS As Workspace
Dim myDB As Database
Dim myTable As Recordset
Dim myID As String
Dim i As Long, j As Long
With Target
If .Count > 1 Then Exit Sub
If .Value = "" Then Exit Sub
If .Row = 1 Then Exit Sub
If .Column <> 1 Then Exit Sub
myID = .Value
End With
Set myWS = DBEngine.Workspaces(0)
Set myDB = myWS.OpenDatabase(DATA_BASE_NAME)
Set myTable = myDB.OpenRecordset(TABLE_NAME, dbOpenDynaset)
With myTable
.FindFirst "注文番号=" & myID
If .NoMatch = False Then
For j = 1 To .Fields.Count - 1
Cells(Target.Row, j + 1).Value = .Fields(j)
Next
Else
MsgBox "注文番号 " & myID & " が見つかりません"
End If
End With
myDB.Close
myWS.Close
End Sub
お試しください。
では
|
|
- 04/1/9(金) 21:46 -
