QML AG/AUG Upload Program

‘—————————————–

‘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

Leave a Comment