‘—————————————–
‘QML AG/AUG Upload Program
‘Author: Zhu.Wei
‘Creation Date: 2013.12.17
‘Change Log:
‘1.Add OpenFile Dialogue Support Windows 7
‘2.Extract Excel Data and Transport to SQL
‘ Server.
‘—————————————–
‘2013.12.17 Zhu Wei New Creation
‘—————————————–
On Error Resume Next
Dim strFileName
dim strPath
dim objConnection
dim objRecordSet
dim objCommand
dim strConnectionString
dim strServer
dim strUID
dim strPWD
dim strDBName
strFileName = GetOpenFileName(“C:\”,”Microsoft Excel|*.xls|Microsoft Excel|*.xlsx|”)
if strFileName = “” then
MsgBox “Cancel AUG Upload !”
Wscript.Quit
End if
strServer = “FSN90035XXXX\DEV”
strUID = “sa”
strPWD = “xxxxxxx”
strDBName = “InfoSys_BackEnd”
‘—-Connect SQL Server—-
ConnectDatabas
‘—Clear Table—
str_sql = “truncate table AUG_Descriptions”
UpdateDatabase str_sql
‘—-Upload Data—
Process_Excel strFileName
‘—-Close SQL Server Connect—
CloseConnection
‘—Update SQL—
Sub UpdateDatabase(strSql)
Dim objCommand
Dim objField
Set objCommand = CreateObject(“ADODB.COMMAND”)
‘Set objRecordSet = CreateObject(“ADODB.RECORDSET”)
objCommand.CommandText = strSql
objCommand.ActiveConnection = objConnection
Set objRecordSet = objCommand.Execute
‘objConnection.Close
Set objCommand = Nothing
‘Set objRecordSet = Nothing
‘set objConnection = Nothing
END Sub
‘—Update StoreProcedre—
Sub EXEC_SP_QML_AUG_UPLOAD(str_p1, str_p2)
Dim objCommand
Dim objField
Dim p1, p2
Set objCommand = CreateObject(“ADODB.COMMAND”)
‘Set objRecordSet = CreateObject(“ADODB.RECORDSET”)
objCommand.CommandType = 4
objCommand.CommandText = “SP_QML_AUG_UPLOAD”
set p1 = CreateObject(“ADODB.Parameter”)
p1.name = “AUG”
P1.Type = 200
p1.size = 50
p1.Direction = 1
p1.value = str_p1
set p2 = CreateObject(“ADODB.Parameter”)
p2.name = “AUG_IMAGE”
P2.Type = 200
p2.size = 50
p2.Direction = 1
p2.value = str_p2
objCommand.Parameters.Append p1
objCommand.Parameters.Append p2
objCommand.ActiveConnection = objConnection
Set objRecordSet = objCommand.Execute
‘objConnection.Close
Set objCommand = Nothing
‘Set objRecordSet = Nothing
‘set objConnection = Nothing
End Sub
‘—Connect SQL Server—
Sub ConnectDatabas
strConnectionString = “DRIVER=SQL Server; SERVER=” & strServer & “; UID=” & strUID & “; PWD=”_
& strPWD & “; DATABASE=” & strDBName & “;”
Set objConnection = CreateObject(“ADODB.CONNECTION”)
objConnection.Open strConnectionString
If (objConnection.State = 0) Then
MsgBox “Connect Database Fail!”
ELSE
‘MsgBox “Connect Database Success！”
End If
END Sub
‘—Close Connection—
Sub CloseConnection
If (objConnection.State = 0) Then
‘MsgBox “Connect Database Fail！”
ELSE
objConnection.Close
set objConnection = Nothing
End If
End Sub
Public Function GetOpenFileName(dir, filter)
Const msoFileDialogFilePicker = 3
If VarType(dir) <> vbString Or dir=”” Then
dir = CreateObject( “WScript.Shell” ).SpecialFolders( “Desktop” )
End If
If VarType(filter) <> vbString Or filter=”” Then
filter = “All files|*.*”
End If
Dim i,j, objDialog, TryObjectNames
TryObjectNames = Array( _
“UserAccounts.CommonDialog”, _
“MSComDlg.CommonDialog”, _
“MSComDlg.CommonDialog.1”, _
“Word.Application”, _
“SAFRCFileDlg.FileOpen”, _
“InternetExplorer.Application” _
)
On Error Resume Next
Err.Clear
For i=0 To UBound(TryObjectNames)
Set objDialog = WSH.CreateObject(TryObjectNames(i))
If Err.Number<>0 Then
Err.Clear
Else
Exit For
End If
Next
Select Case i
Case 0,1,2
‘ 0. UserAccounts.CommonDialog XP Only.
‘ 1.2. MSComDlg.CommonDialog MSCOMDLG32.OCX must registered.
If i=0 Then
objDialog.InitialDir = dir
Else
objDialog.InitDir = dir
End If
objDialog.Filter = filter
If objDialog.ShowOpen Then
GetOpenFileName = objDialog.FileName
End If
Case 3
‘ 3. Word.Application Microsoft Office must installed.
objDialog.Visible = False
Dim objOpenDialog, filtersInArray
filtersInArray = Split(filter, “|”)
Set objOpenDialog = _
objDialog.Application.FileDialog( _
msoFileDialogFilePicker)
With objOpenDialog
.Title = “Open File(s):”
.AllowMultiSelect = False
.InitialFileName = dir
.Filters.Clear
For j=0 To UBound(filtersInArray) Step 2
.Filters.Add filtersInArray(j), _
filtersInArray(j+1), 1
Next
If .Show And .SelectedItems.Count>0 Then
GetOpenFileName = .SelectedItems(1)
End If
End With
objDialog.Visible = True
objDialog.Quit
Set objOpenDialog = Nothing
Case 4
‘ 4. SAFRCFileDlg.FileOpen xp 2003 only
If objDialog.OpenFileOpenDlg Then
GetOpenFileName = objDialog.FileName
End If
Case 5
‘ 5. InternetExplorer.Application IE must installed
objDialog.Navigate “about:blank”
Dim objBody, objFileDialog
Set objBody = _
objDialog.document.getElementsByTagName(“body”)(0)
objBody.innerHTML = “<input type=’file’ id=’fileDialog’>”
while objDialog.Busy Or objDialog.ReadyState <> 4
WScript.sleep 10
Wend
Set objFileDialog = objDialog.document.all.fileDialog
objFileDialog.click
GetOpenFileName = objFileDialog.value
objDialog.Quit
Set objFileDialog = Nothing
Set objBody = Nothing
Case Else
‘ Sorry I cannot do that!
End Select
Set objDialog = Nothing
End Function
‘Process_Excel lv_filename
‘CloseProcess “AUG_UPDATE.VBS”
Sub Process_Excel(strFileName)
Set objExcel = CreateObject(“Excel.Application”)
set objbooks = objExcel.Workbooks.Open(strFileName)
set oSheet=objbooks.Worksheets(“AUG”)
ObjExcel.Visible = False
intRow = 2
DO Until oSheet.Cells(intRow,1).Value = “”
‘Wscript.Echo “CN: ” & oSheet.Cells(intRow, 1).Value
EXEC_SP_QML_AUG_UPLOAD oSheet.Cells(intRow, 1).Value,oSheet.Cells(intRow, 2).Value
intRow = intRow + 1
LOOP
objbooks.Close
objExcel.Quit
Set oSheet = Nothing
Set objbooks = Nothing
Set objExcel = Nothing
Wscript.Echo “Success: Upload AUG Done !”
End Sub