1712 lines
46 KiB
QBasic
1712 lines
46 KiB
QBasic
Option Explicit
|
|
|
|
Sub MGRP()
|
|
|
|
Dim x As New TheBigOne
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim i As Long 'indexer
|
|
Dim j As Long 'block indexer
|
|
Dim b As Long 'block size
|
|
Dim sql As String
|
|
Dim sh As Worksheet
|
|
|
|
Set sh = Sheets("MGRP")
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM FANALYSIS.FFMGRP") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
i = 4
|
|
b = 500
|
|
j = 1
|
|
sql = "INSERT INTO FANALYSIS.FFMGRP VALUES " & vbCrLf
|
|
Do Until sh.Cells(i, 1) = ""
|
|
If j >= b Then
|
|
If Not x.ADOp_Exec(0, sql) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
j = 1
|
|
sql = "INSERT INTO FANALYSIS.FFMGRP VALUES " & vbCrLf
|
|
End If
|
|
If j > 1 Then sql = sql & "," & vbCrLf
|
|
sql = sql & "('" & sh.Cells(i, 1) & "','" & sh.Cells(i, 2) & "')"
|
|
i = i + 1
|
|
j = j + 1
|
|
Loop
|
|
|
|
If Not x.ADOp_Exec(0, sql) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
End Sub
|
|
|
|
Sub RGRP()
|
|
|
|
Dim x As New TheBigOne
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim i As Long 'indexer
|
|
Dim j As Long 'block indexer
|
|
Dim b As Long 'block size
|
|
Dim sql As String
|
|
Dim sh As Worksheet
|
|
|
|
Set sh = Sheets("RGRP")
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM FANALYSIS.FFRGRP") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
i = 4
|
|
b = 500
|
|
j = 1
|
|
sql = "INSERT INTO FANALYSIS.FFRGRP VALUES " & vbCrLf
|
|
Do Until sh.Cells(i, 1) = ""
|
|
If j >= b Then
|
|
If Not x.ADOp_Exec(0, sql) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
j = 1
|
|
sql = "INSERT INTO FANALYSIS.FFRGRP VALUES " & vbCrLf
|
|
End If
|
|
If j > 1 Then sql = sql & "," & vbCrLf
|
|
sql = sql & "('" & sh.Cells(i, 1) & "','" & sh.Cells(i, 2) & "','" & sh.Cells(i, 3) & "','" & sh.Cells(i, 4) & "')"
|
|
i = i + 1
|
|
j = j + 1
|
|
Loop
|
|
|
|
If Not x.ADOp_Exec(0, sql) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
End Sub
|
|
|
|
Sub ACCTX()
|
|
|
|
Dim x As New TheBigOne
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim i As Long 'indexer
|
|
Dim j As Long 'block indexer
|
|
Dim b As Long 'block size
|
|
Dim sql As String
|
|
Dim sh As Worksheet
|
|
|
|
Set sh = Sheets("ACCTX")
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM QGPL.FFACCTX") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
i = 4
|
|
b = 500
|
|
j = 1
|
|
sql = "INSERT INTO QGPL.FFACCTX VALUES " & vbCrLf
|
|
Do Until sh.Cells(i, 1) = ""
|
|
If j >= b Then
|
|
If Not x.ADOp_Exec(0, sql) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
j = 1
|
|
sql = "INSERT INTO QGPL.FFACCTX VALUES " & vbCrLf
|
|
End If
|
|
If j > 1 Then sql = sql & "," & vbCrLf
|
|
sql = sql & "('" & sh.Cells(i, 1) & "','" & sh.Cells(i, 2) & "','" & sh.Cells(i, 3) & "','" & sh.Cells(i, 4) & "')"
|
|
i = i + 1
|
|
j = j + 1
|
|
Loop
|
|
|
|
If Not x.ADOp_Exec(0, sql) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
End Sub
|
|
|
|
Sub UCNV()
|
|
|
|
Dim x As New TheBigOne
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim i As Long 'indexer
|
|
Dim j As Long 'block indexer
|
|
Dim b As Long 'block size
|
|
Dim sql As String
|
|
Dim sh As Worksheet
|
|
|
|
Set sh = Sheets("UCNV")
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM QGPL.FFUCNV") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
i = 4
|
|
b = 500
|
|
j = 1
|
|
sql = "INSERT INTO QGPL.FFUCNV VALUES " & vbCrLf
|
|
Do Until sh.Cells(i, 1) = ""
|
|
If j >= b Then
|
|
If Not x.ADOp_Exec(0, sql) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
j = 1
|
|
sql = "INSERT INTO QGPL.FFUCNV VALUES " & vbCrLf
|
|
End If
|
|
If j > 1 Then sql = sql & "," & vbCrLf
|
|
sql = sql & "('" & sh.Cells(i, 1) & "','" & sh.Cells(i, 2) & "'," & sh.Cells(i, 3) & ")"
|
|
i = i + 1
|
|
j = j + 1
|
|
Loop
|
|
|
|
If Not x.ADOp_Exec(0, sql) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
End Sub
|
|
|
|
Sub LPN()
|
|
|
|
Dim x As New TheBigOne
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim i As Long 'indexer
|
|
Dim j As Long 'block indexer
|
|
Dim b As Long 'block size
|
|
Dim sql As String
|
|
Dim sh As Worksheet
|
|
|
|
Set sh = Sheets("LPN")
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM QGPL.FFLPN") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
i = 4
|
|
b = 500
|
|
j = 1
|
|
sql = "INSERT INTO QGPL.FFLPN VALUES " & vbCrLf
|
|
Do Until sh.Cells(i, 1) = ""
|
|
If j >= b Then
|
|
If Not x.ADOp_Exec(0, sql) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
j = 1
|
|
sql = "INSERT INTO QGPL.FFLPN VALUES " & vbCrLf
|
|
End If
|
|
If j > 1 Then sql = sql & "," & vbCrLf
|
|
sql = sql & "(" & sh.Cells(i, 1) & ")"
|
|
i = i + 1
|
|
j = j + 1
|
|
Loop
|
|
|
|
If Not x.ADOp_Exec(0, sql) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
End Sub
|
|
|
|
Sub FFFX()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", True) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("FFFX", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "QGPL.FFFX"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "F", "F"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
Call FA_FFFX
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
End Sub
|
|
|
|
Sub FA_FFFX()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", True) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("FFFX", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "FANALYSIS.FFFX"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "F", "F"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
Sub PERDD()
|
|
|
|
Dim x As New TheBigOne
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim i As Long 'indexer
|
|
Dim j As Long 'block indexer
|
|
Dim b As Long 'block size
|
|
Dim sql As String
|
|
Dim sh As Worksheet
|
|
|
|
Set sh = Sheets("PERDD")
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM QGPL.FFPERDD") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
i = 3
|
|
b = 500
|
|
j = 1
|
|
sql = "INSERT INTO QGPL.FFPERDD VALUES " & vbCrLf
|
|
Do Until sh.Cells(i, 1) = ""
|
|
If j >= b Then
|
|
If Not x.ADOp_Exec(0, sql) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
j = 1
|
|
sql = "INSERT INTO QGPL.FFPERDD VALUES " & vbCrLf
|
|
End If
|
|
If j > 1 Then sql = sql & "," & vbCrLf
|
|
sql = sql & "('" & sh.Cells(i, 2) & "','" & sh.Cells(i, 2) & "','" & sh.Cells(i, 3) & "','" & sh.Cells(i, 4) & "','" & sh.Cells(i, 5) & "','" & sh.Cells(i, 6) & "','" & sh.Cells(i, 7) & "','" & sh.Cells(i, 8) & "','" & sh.Cells(i, 9) & "','" & sh.Cells(i, 10) & "','','',0)"
|
|
i = i + 1
|
|
j = j + 1
|
|
Loop
|
|
|
|
If Not x.ADOp_Exec(0, sql) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
End Sub
|
|
|
|
|
|
Sub CRET_SS()
|
|
|
|
Dim x As New TheBigOne
|
|
|
|
If Not x.ADOp_OpenCon(0, SqlServer, "MID-SQL02", True) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim i As Long 'indexer
|
|
Dim j As Long 'block indexer
|
|
Dim b As Long 'block size
|
|
Dim sql As String
|
|
Dim sh As Worksheet
|
|
|
|
Set sh = Sheets("CRET")
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM FAnalysis.R.FFCRET") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
If Not x.ADOp_InsertRecordsS(x.SHTp_Get(sh.Name, 1, 1, True), 0, "FAnalysis.R.FFCRET", True) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
End Sub
|
|
|
|
Sub PRRUN()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, SqlServer, "MID-SQL02", True) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("PRRUN", 1, 1, False)
|
|
inc = 500
|
|
targ_file = "Fanalysis.dbo.PRRUN_IMPORT"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 0
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, i + inc, Array("F", "F", "S", "S", "S", "F", "S", "F", "F", "S", "S", "S", "S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------run import proc----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "EXEC IMPORT_PRRUN") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
End If
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
|
|
|
|
End Sub
|
|
|
|
Sub FR8M8()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, SqlServer, "MID-SQL02", True) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("FR8M8", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "FANALYSIS.R.FR8M8"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S", "F", "F", "F", "F", "F", "F", "F", "F", "S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
|
|
End Sub
|
|
|
|
Sub CRET()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "PTROWBRIDG", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("CRET", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "RLARP.FFCRET"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S", "S", "S", "F"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
Call CRET_SS
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
|
|
End Sub
|
|
|
|
Sub CHNL_DB2()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("CHNL", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "RLARP.FFCHNL"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S", "S", "S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
|
|
End Sub
|
|
|
|
Sub CHNL_MS()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, SqlServer, "MID-SQL02", True) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("CHNL", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "R.FFCHNL"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S", "S", "S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
Sub TERR_DB2()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", True) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("TERR", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "RLARP.FFTERR"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S", "S", "S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
|
|
End Sub
|
|
|
|
Sub FFMGRP()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
End If
|
|
|
|
If Not x.ADOp_OpenCon(1, SqlServer, "MID-SQL02", True) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("MGRP", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "RLARP.FFMGRP"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 0
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, i + inc, Array("S", "S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------run import proc----------------------------
|
|
|
|
If Not x.ADOp_Exec(1, "EXEC IMPORT_FFMGRP") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
End If
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
|
|
|
|
End Sub
|
|
|
|
Sub FFRGRP()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
End If
|
|
|
|
If Not x.ADOp_OpenCon(1, SqlServer, "MID-SQL02", True) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("RGRP", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "RLARP.FFRGRP"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, i + inc, Array("S", "S", "S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------run import proc----------------------------
|
|
|
|
If Not x.ADOp_Exec(1, "EXEC IMPORT_FFRGRP") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
End If
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
|
|
|
|
End Sub
|
|
|
|
Sub FFCUST_DB2()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("CUST", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "RLARP.FFCUST"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
|
|
MsgBox ("Upload Successful")
|
|
End Sub
|
|
|
|
Sub FFCUST_MS()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, SqlServer, "MID-SQL02", True) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("CUST", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "R.FFCUST"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
|
|
MsgBox ("Upload Successful")
|
|
End Sub
|
|
|
|
Sub FFPTPL()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("PTPL", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "RLARP.FFPTPL"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
|
|
MsgBox ("Upload Successful")
|
|
End Sub
|
|
|
|
Sub FFPRRP()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("FFPRRP", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "RLARP.FFPRRP_I"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S", "S", "S", "S", "F", "F", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "F"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'--------------move to live-------------
|
|
|
|
If Not x.ADOp_Exec(0, "INSERT INTO RLARP.FFPRRP SELECT * FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
|
|
MsgBox ("Upload Successful")
|
|
End Sub
|
|
|
|
Sub FFPRCD()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("FFPRCD", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "RLARP.FFPRCD"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S", "S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
|
|
MsgBox ("Upload Successful")
|
|
End Sub
|
|
|
|
|
|
Sub FFPRRP_U()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("FFPRRP_U", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "RLARP.FFPRRP_I"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S", "S", "S", "S", "F", "F", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "F"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'--------------move to live-------------
|
|
|
|
If Not x.ADOp_Exec(0, "INSERT INTO RLARP.FFPRRP SELECT * FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
|
|
MsgBox ("Upload Successful")
|
|
End Sub
|
|
|
|
Sub FFCRED()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, SqlServer, "MID-SQL02", True) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("FFCRED", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "R.FFCRED"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S", "F", "F"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
|
|
MsgBox ("Upload Successful")
|
|
End Sub
|
|
|
|
|
|
Sub FRRATE()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, SqlServer, "MID-SQL02", True) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("FRRATE", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "FANALYSIS.R.FRRATE"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S", "S", "S", "F", "S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
|
|
End Sub
|
|
|
|
Sub FRDIST()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, SqlServer, "MID-SQL02", True) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("FRDIST", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "FANALYSIS.R.FRDIST"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S", "S", "S", "F", "S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
|
|
End Sub
|
|
|
|
Sub map_rv()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "USHCC10091", False, "ptrowbridge", "password", "DATABASE=hcfin") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("map_rv", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "tps.map_rv"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S", "S", "S", "F", "S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
|
|
End Sub
|
|
|
|
Sub COLR()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, SqlServer, "MID-SQL02", True) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("COLR", 1, 1, True)
|
|
inc = 500
|
|
targ_file = "R.NMC_COL"
|
|
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
|
|
End Sub
|
|
|
|
Sub FFVERS()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("FFVERS", 1, 1, True)
|
|
inc = 25
|
|
targ_file = "QGPL.FFVERS"
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S", "S", "N"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
|
|
End Sub
|
|
|
|
Sub FFBS0516()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("BS0516", 1, 1, True)
|
|
inc = 25
|
|
targ_file = "QGPL.FFBS0516"
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "N", "N", "N", "N", "N", "N", "S", "S", "S", "S", "D", "D", "D", "D", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "N", "S", "N", "N", "N", "N", "S", "S", "D", "D", "D", "N", "N", "N", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
|
|
Sub FAMILY()
|
|
|
|
'-------------instantiate variables----------------------------
|
|
|
|
Dim x As New TheBigOne
|
|
Dim i As Long
|
|
Dim inc As Long
|
|
Dim targ_file As String
|
|
Dim UPLOAD() As String
|
|
|
|
|
|
'-------------open connection on target DB---------------------
|
|
|
|
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, "ptrowbridg", "password") Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
'-------------set variables------------------------------------
|
|
|
|
UPLOAD = x.SHTp_Get("FAMILY", 1, 1, True)
|
|
inc = 25
|
|
targ_file = "RLARP.FAMILY"
|
|
|
|
'-------------clear out import file----------------------------
|
|
|
|
If Not x.ADOp_Exec(0, "DELETE FROM " & targ_file) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
'-------------populate import file with array contents---------
|
|
|
|
i = 1
|
|
Do While i <= UBound(UPLOAD, 2)
|
|
If Not x.ADOp_Exec(0, x.ADOp_BuildInsertSQL(UPLOAD, targ_file, True, i, WorksheetFunction.Min(i + inc, UBound(UPLOAD, 2)), Array("S", "S"))) Then
|
|
MsgBox (x.ADOo_errstring)
|
|
Call x.ADOp_CloseCon(0)
|
|
Exit Sub
|
|
End If
|
|
i = i + inc + 1
|
|
If i > UBound(UPLOAD, 2) Then Exit Do
|
|
If i + inc > UBound(UPLOAD, 2) Then inc = UBound(UPLOAD, 2) - i
|
|
Loop
|
|
|
|
'-------------close out the connection--------------------------
|
|
|
|
Call x.ADOp_CloseCon(0)
|
|
|
|
MsgBox ("Upload Successful")
|
|
|
|
|
|
End Sub
|