Skip to content

Instantly share code, notes, and snippets.

@cofearabi
Created June 26, 2013 04:57
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save cofearabi/5864873 to your computer and use it in GitHub Desktop.
Save cofearabi/5864873 to your computer and use it in GitHub Desktop.
get excel data and put data into access
Private Sub CommandButton1_Click()
Dim int_sheets_no
'int_sheets_no = Int(InputBox("", "", "1"))
int_sheets_no = 1
int_line = 2
Do While Worksheets(int_sheets_no).Range("B" & int_line).Value <> ""
str_temp1 = Worksheets(int_sheets_no).Range("A" & int_line).Value
str_temp2 = Worksheets(int_sheets_no).Range("B" & int_line).Value
' MsgBox str_temp2
Call add_mdb(str_temp1, str_temp2)
int_line = int_line + 1
str_Temp_line = str_Temp_line & vbCrLf & str_temp2
Loop
' xlApp.Quit
Set xlbook = Nothing
Set xlApp = Nothing
' MsgBox "error" & Err.Description
End Sub
Function add_mdb(date_0, contents_0)
add_mdb = "0"
Set conn_1 = CreateObject("ADODB.Connection")
Set rs_1 = CreateObject("ADODB.Recordset")
conn_1.Open "Driver={Microsoft Access Driver (*.mdb)}; DBQ=c:\mdb\diary.mdb"
intCount = 0
rs_1.Open "select * from diary where c like '" & contents_0 & "'", conn_1, 3, 3
If rs_1.EOF <> True And rs_1.BOF <> True Then
MsgBox "already exists " & vbCrLf & contents_0
Else
rs_1.addnew
rs_1.Fields("d") = date_0
rs_1.Fields("c") = contents_0
rs_1.Update
rs_1.Close
End If
conn_1.Close
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment