Before we get started I need to let you know a critical piece of information: Due to permissions within an offsite database I amNOT allowed to create tables even temporary ones within the database that I am getting the data from.
With that being said: All of the code below works as expected, but I would like a review of it because I know that there has to be a more efficient way of writing both the SQL String and the script within VBA.
Steps in the process
- Get Data from a SQL Server (please note that I am only getting the first 20 rows as a data set to test, but the final result will be well over 10,000 rows of data)
- Excel VBA Macros to grab data with the below SQL String
- Save File as a CSV file (This is already completed and working, so no need to address this item.
SQL String
SELECT cfcif# AS "Customer Number", cffna AS "First Name", cfmna AS "Middle Name", COALESCE( NULLIF(cflna,''),cfna1) AS "Last Name", COALESCE( NULLIF( RTRIM(LTRIM(cfpfa1))|| ' '|| RTRIM(LTRIM(cfpfa2)),''),RTRIM(LTRIM(cfna2))|| ' ' || RTRIM(LTRIM(cfna3))) AS "Street Address", COALESCE( NULLIF(cfpfcy,''),cfcity) AS "Street City", COALESCE( NULLIF(cfpfst,''),cfstat) AS "Street State", COALESCE( NULLIF(LEFT(cfpfzc, 5), 0), LEFT(cfzip, 5)) AS "Street Zip", RTRIM(LTRIM(cfna2))|| ' ' || RTRIM(LTRIM(cfna3)) AS "Mailing Address", cfcity AS "Mailing City", cfstat AS "Mailing State", LEFT(cfzip, 5) AS "Mailing Zip", NULLIF(cfhpho,0) AS "Home Phone", NULLIF(cfbpho,0) AS "Business Phone", NULLIF(cfssno,0) AS "TIN", (CASE WHEN cfindi = 'Y' THEN '1' WHEN cfindi = 'N' THEN '2' END) AS "Customer Type", (CASE WHEN cfdob7 = 0 THEN NULL WHEN cfdob7 = 1800001 THEN NULL ELSE cfdob7 END) AS "Date of Birth", cfeml1 AS "Email Address" FROM bhschlp8.jhadat842.cfmast cfmast WHERE cfdead = 'N' ORDER BY cfcif# FETCH FIRST 20 ROWS ONLYEXCEL
Private Sub Workbook_Open() GetDataEnd SubThe below Code is in a Standard Module called ConstVars
Option ExplicitPublic Const BRANSONSERVER As String = "bhschlp8.jhadat842.cfmast cfmast"Public Const CHARLOTTESERVER As String = "cncttp08.jhadat842.cfmast cfmast"Public Const CONNECTIONERROR As Long = -2147467259Public Const CONNECTIONSTRING As String = Redacted for public viewingThe below code resides in a Standard Module called CiF
Option ExplicitSub GetData() AddHeaders getDBGrabTestRecord (Array(BRANSONSERVER, CHARLOTTESERVER)) Sheet1.Cells.EntireColumn.AutoFitEnd SubPrivate Function getDBGrabTestRecord(arrNames) Dim conn As Object Set conn = CreateObject("ADODB.Connection") Dim rs As Object Set rs = CreateObject("ADODB.Recordset") Dim nm conn.Open CONNECTIONSTRING For Each nm In arrNames Dim SQL As String SQL = getDBGrabSQL(CStr(nm)) On Error Resume Next rs.Open SQL, conn Dim okSQL As Boolean If Err.Number = 0 Then okSQL = True On Error GoTo 0 If okSQL Then If Not rs.EOF Then Sheet1.Range("A2").CopyFromRecordset rs End If Exit For End If Next nmEnd FunctionPrivate Function getCIFDBGrabTestRecord(arrNames) Dim SQL As String On Error Resume Next conn.Open CONNECTIONSTRING SQL = getDBGrabSQL(TableName) rs.Open SQL, conn tDBGrabRecord.ErrNumber = Err.Number If Not (rs.BOF And rs.EOF) Then rs.MoveFirst Sheet1.Range("A2").CopyFromRecordset rs End If rs.Close conn.CloseEnd FunctionPrivate Function getDBGrabSQL(ByVal TableName As String) As String Dim SelectClause As String Dim FromClause As String Dim WhereClause As String Dim OrderClause As String Dim FetchClause As String SelectClause = GetSelectClause FromClause = "FROM " & TableName WhereClause = "WHERE cfdead = " & "'" & "N" & "'" OrderClause = "ORDER BY cfcif#" FetchClause = "FETCH FIRST 20 ROWS ONLY" getDBGrabSQL = SelectClause & vbNewLine & FromClause & vbNewLine & WhereClause & vbNewLine & OrderClause & vbNewLine & FetchClause Debug.Print getDBGrabSQLEnd FunctionPrivate Function GetSelectClause() As String Const Delimiter As String = vbNewLine Dim list As Object Set list = CreateObject("System.Collections.ArrayList") With list .Add "SELECT cfcif#," .Add "cffna," .Add "cfmna," .Add "COALESCE(" .Add "NULLIF(cflna,''),cfna1)," .Add "COALESCE(" .Add "NULLIF(" .Add "RTRIM(LTRIM(cfpfa1))|| ' '|| RTRIM(LTRIM(cfpfa2)),''),RTRIM(LTRIM(cfna2))|| ' ' || RTRIM(LTRIM(cfna3)))," .Add "COALESCE(" .Add "NULLIF(cfpfcy,''),cfcity)," .Add "COALESCE(" .Add "NULLIF(cfpfst,''),cfstat)," .Add "COALESCE(" .Add "NULLIF(LEFT(cfpfzc, 5), 0), LEFT(cfzip, 5))," .Add "RTRIM(LTRIM(cfna2))|| ' ' || RTRIM(LTRIM(cfna3))," .Add "cfcity," .Add "cfstat," .Add "LEFT(cfzip, 5)," .Add "NULLIF(cfhpho,0)," .Add "NULLIF(cfbpho,0)," .Add "NULLIF(cfssno,0)," .Add "(CASE" .Add "WHEN cfindi = 'Y' THEN '1'" .Add "WHEN cfindi = 'N' THEN '2'" .Add "END)," .Add "(CASE" .Add "WHEN cfdob7 = 0 THEN NULL" .Add "WHEN cfdob7 = 1800001 THEN NULL" .Add "ELSE cfdob7" .Add "END)," .Add "cfeml1" End With GetSelectClause = Join(list.ToArray, Delimiter)End FunctionThe below code resides in a Standard Module called Formatting(I havent given the Sheet or Cells names yet)
Option ExplicitPublic Sub AddHeaders() Sheet1.Range("A1") = "Customer Number" Sheet1.Range("B1") = "First Name" Sheet1.Range("C1") = "Middle Name" Sheet1.Range("D1") = "Last Name" Sheet1.Range("E1") = "Street Address" Sheet1.Range("F1") = "Street City" Sheet1.Range("G1") = "Street State" Sheet1.Range("H1") = "Street Zip" Sheet1.Range("I1") = "Mailing Address" Sheet1.Range("J1") = "Mailing City" Sheet1.Range("K1") = "Mailing State" Sheet1.Range("L1") = "Mailing Zip" Sheet1.Range("M1") = "Home Phone" Sheet1.Range("N1") = "Work Phone" Sheet1.Range("O1") = "TIN" Sheet1.Range("P1") = "Customer Type" Sheet1.Range("Q1") = "Date of Birth" Sheet1.Range("R1") = "Email Address"End Sub1 Answer1
I can't be much help on the SQL front, but for VBA, I would recommend grouping yourDim statements, as it ultimately reduces compile time (scales well). For instance:
Dim SelectClause As String Dim FromClause As String Dim WhereClause As String Dim OrderClause As String Dim FetchClause As StringBecomes
Dim SelectClause as String, FromClause As String, WhereClause As String, _ OrderClause As String, FetchClause As StringAlso, we can clean up this last Formatting module quite a bit. If this gets any bigger or either your destination range or your destination sheet changes, you'll be glad you refactored:
Public Sub AddHeaders()Dim mySheet as Worksheet: Set mySheet = Sheet1Dim labelText as Variant'I'm putting linebreaks so that they are grouped nicelylabelText = Array("Customer Number", "First Name", "Middle Name", "Last Name", _ "Street Address", "Street City", "Street State", "Street Zip", _ "Mailing Address", "Mailing City", "Mailing State", "Mailing Zip", _ "Home Phone", "Work Phone", _ "TIN", "Customer Type", "Date of Birth", _ "Email Address")For i = 1 to UBound(labelText) mySheet.Cells(i, 1).Value = labelText(i)Next iEnd SubI'm a big fan of puttingSet statements on the same line asDim statements if it's a widely used variable throughout the procedure, as it is clearly an important statement.
Everything else looks good. Only other thing is that I prefer to putDim statements outside of the loops if I can. Some people prefer putting them before assigning the variable, to keep track of local variables, but I always feel like it clutters loops. In this instance, you're using it to reset your Boolean so I'd leave it.
- \$\begingroup\$Thanks. I always go back and forth on grouping
Dimstatements, and I dont know why i always forget about usingArraysespecially since its such a huge part of VBA. I am going to upvote this answer, but I am going to wait a few days to see what others come up with especially with the SQL String. Thanks for taking a look I really appreciate it.\$\endgroup\$Zack E– Zack E2020-01-21 15:44:56 +00:00CommentedJan 21, 2020 at 15:44 - \$\begingroup\$I've never used SQL so it would be an injustice to you for me to attempt to review it haha.
Arraysare fine and dandy, but iflabelTexthas any possibility of being modified, I'd use a collection. VBA kind of sucks for modifying arrays (no push, pop, shift).\$\endgroup\$jclasley– jclasley2020-01-21 15:50:40 +00:00CommentedJan 21, 2020 at 15:50 - \$\begingroup\$
labelTextwont be modified since its part of a hardcoded dataset on another server. I did make one change to the loop inAddHeadersprocedure though; sinceArraysare zero based i changedFor i = 1 to UBound(labelText) mySheet.Cells(i, 1).Value = labelText(i) Next itoDim i As Long For i = 0 To UBound(labelText) mySheet.Cells(1, i + 1).Value = labelText(i) Next i\$\endgroup\$Zack E– Zack E2020-01-21 16:01:09 +00:00CommentedJan 21, 2020 at 16:01 - 1\$\begingroup\$I actually think it's better the way it's written.
Dim labelText(0 to 17) as Stringinitializes an 18-string length array with an empty string at each position. This is useful if you know the amount of content you'll have but don't know the contents. Then you can go in adding them as you see fit. However, when we already know exactly what will be in the array, it's much easier to initialize the array with its values rather than initializing an empty array to be filled in later.\$\endgroup\$jclasley– jclasley2020-01-21 16:17:14 +00:00CommentedJan 21, 2020 at 16:17 - 1\$\begingroup\$@jclasley Declaring variables separately has a negligible impact at compile time. Grouping them as you have suggested actually clutters code. What should be done is to declare variables close to where they are being used, as it greatly improves readability. That being said, no matter what, one should never declare a variable in a loop unless there is no alternative. Such would be the the case when using
ReDim Preservefor increasing the size of a dynamic array, but doing so is not recommended as you will definitely take a performance hit.\$\endgroup\$ARickman– ARickman2020-01-25 21:28:18 +00:00CommentedJan 25, 2020 at 21:28
You mustlog in to answer this question.
Explore related questions
See similar questions with these tags.