Skip to content

Instantly share code, notes, and snippets.

Created June 23, 2013 16:16
Show Gist options
  • Save anonymous/5845553 to your computer and use it in GitHub Desktop.
Save anonymous/5845553 to your computer and use it in GitHub Desktop.
VBScript which get data from a Excel file and put them into a Access table.
Dim str_temp_line
Set arg=Wscript.Arguments
if arg.Count = 0 then
szArg0="c:\xls\diary.xls"
else
szArg0=arg.Item(0)
end if
msgbox szArg0
set xlapp=createobject("Excel.Application")
xlapp.visible=true
xlapp.displayalerts=False
set xlbook=xlApp.Workbooks.open(szArg0)
Dim int_sheets_no
int_sheets_no = int(inputbox("","","1"))
int_line = 2
Do while xlbook.worksheets(int_sheets_no).Range("B" & int_line).value <> ""
str_temp1 = xlbook.worksheets(int_sheets_no).Range("A" & int_line).value
str_temp2 = xlbook.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
if Err.Description <> "" then
msgbox "error" & Err.Description
end if
strFileName="c:\xls\sample_" & Cstr(int_sheets_no) & ".txt"
set objFileSystem=CreateObject("Scripting.FileSystemObject")
set objFile=objFileSystem.CreateTextFile(strFileName)
objFile.Write(str_Temp_line)
objFile.Write(vbCrLf)
objFile.close
msgbox "end"
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
add_mdb = "already exists"
'MsgBox add_mdb
Else
rs_1.addnew
rs_1.Fields("d") = date_0
rs_1.Fields("c") = contents_0
rs_1.Update
rs_1.Close
msgbox contents_0
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