+ 1

VBA project failing to extract data to excel file what could be wrong?

A vba that is assigned to extract and export data/values from an SQL database to an excel file, the script ran just fine from the time it was deploy 6 years ago up until 3 weeks ago when we tried to run November-december records

13th Dec 2019, 5:06 PM
Fortune jabulani Lungu
Fortune jabulani Lungu - avatar
4 Answers
+ 2
What error are you getting and on which line?
13th Dec 2019, 6:19 PM
Ally Wash
Ally Wash - avatar
+ 1
error 1004 on the select line and on other instances the sheets are coming back null with all numeric values being zero. i have tried using two different tools from two different departments the result is the same
16th Dec 2019, 10:38 AM
Fortune jabulani Lungu
Fortune jabulani Lungu - avatar
+ 1
Option Explicit Public Const NUMBER_OF_BRANCHES = 8 Public Const FIRST_ROW = 4 Public Const SHEET_INSURANCE = "Insurance" Public Const SHEET_REPEAT_LOANS = "RepeatLoans" Sub Execute() ClearContent SHEET_INSURANCE ExtractData SHEET_INSURANCE AutoFillFormulas SHEET_INSURANCE ClearContent SHEET_REPEAT_LOANS ExtractDataRepeatLoans SHEET_REPEAT_LOANS AutoFillFormulas SHEET_REPEAT_LOANS Application.Calculation = xlCalculationAutomatic End Sub Private Sub ClearContent(ByVal sheet As String) Sheets(sheet).Select Rows(CStr(FIRST_ROW + 1) & ":" & CStr(GetLastRow(sheet))).Select Selection.ClearContents Range("A" & CStr(FIRST_ROW) & ":" & "N" & CStr(FIRST_ROW)).Select Selection.ClearContents End Sub Private Sub AutoFillFormulas(ByVal sheet As String) Dim rangeSource As String rangeSource = "O" & CStr(FIRST_ROW) & ":" & "Q" & CStr(FIRST_ROW) Dim rangeDestination As String rangeDestination = "O" & CStr(FIRST_ROW) & ":" & "Q" & CStr(GetLastRowOfColumn("A", sheet)) AutoFill rangeSource, rangeDestination, sheet End Sub Private Sub ExtractData(ByVal sheet As String) Dim cnx As ADODB.Connection Dim rst As ADODB.Recordset Dim cmd As ADODB.Command Set cnx = New ADODB.Connection Set rst = New ADODB.Recordset Set cmd = New ADODB.Command Sheets(sheet).Select Dim dateFrom As String dateFrom = Range("NM_DATE_FROM").Value Dim dateTo As String dateTo = Range("NM_DATE_TO").Value cnx.ConnectionString = "UID=angelalihusha;PWD=Prov1921*;DRIVER={SQL Server};Server=" & Range("DB_SERVER").Value & ";Database=" & Range("DB_NAME").Value & ";" cnx.Open cmd.CommandText = "Select * from( " & _ "select case when loanDisbursement.LOAN_NUMBER < 200000 then 1 when loanDisbursement.LOAN_NUMBER >=200000 and loanDisbursement.LOAN_NUMBER < 3
16th Dec 2019, 10:59 AM
Fortune jabulani Lungu
Fortune jabulani Lungu - avatar
0
Option Explicit Dim QryTableConn As String Dim dbName As String Dim fromDate As String Dim toDate As String Dim instanceName As String Dim PctDone As Single ' Percent of process done Dim Counter As Integer ' Counter for the process step Dim NbLine As Integer ' Number of line to fill Dim canBuildSummary As Boolean Dim loanType As String Public Const SHEET_SUMMARY = "Summary" Public Const DASHBOARD_COL_NAME = "B" Public Const DASHBOARD_COL_PORTFOLIO = "C" Public Const DASHBOARD_COL_PAR1 = "D" Public Const DASHBOARD_COL_PAR30 = "E" Public Const DASHBOARD_COL_POTENTIAL_INCENTIVE = "F" Public Const DASHBOARD_COL_INCENTIVE = "G" Sub ShowUserForm() ProgressBar.Show End Sub Function StepProgress() As Boolean Counter = Counter + 1 StepProgress = UpdateProgressBar(Counter / NbLine) End Function Function UpdateProgressBar(PctDone As Single) As Boolean With ProgressBar ' Update the Caption property of the Frame control. .FrameProgress.Caption = Format(PctDone, "0%") ' Widen the Label control. .LabelProgress.Width = PctDone * _ (.FrameProgress.Width - 10) UpdateProgressBar = .working End With ' The DoEvents allows the UserForm to update. DoEvents End Function Sub InitializeParameters() fromDate = Range("NM_FROM_DATE") toDate = Range("NM_TO_DATE") dbName = Range("NM_DB_NAME") instanceName = Range("NM_DB_INSTANCE_NAME") canBuildSummary = True End Sub Sub BuildConnxString(ByVal dbName As String) 'QryTableConn = "ODBC;DRIVER=SQL Server;SERVER=" & instanceName & ";UID=Report;PWD=pfsl;APP=Microsoft Office 2003;DATABASE=" & dbName 'QryTableConn = "ODBC;DRIVER=SQL Server;SERVER=" & instanceName & ";Trusted_Connection = yes;APP=Microsoft Office 2003;DATABASE=" & dbName ' If Sheets(1).Range("A1").Value = "2" Then ' ' Set up the database connection string ' QryTableConn = "ODBC;UID=sa;Pwd=S
16th Dec 2019, 10:46 AM
Fortune jabulani Lungu
Fortune jabulani Lungu - avatar