+ 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
4 Respuestas
+ 2
What error are you getting and on which line?
+ 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
+ 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
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