Skip to main content
Code Review

Return to Answer

replaced http://stackoverflow.com/ with https://stackoverflow.com/
Source Link

Some of your variable names are good but some are too short/unclear (cn, rst1 and cmd) and strQuery looks like you might be thinking of using Hungarian notation. See this post this post for a discussion of Hungarian. The main thing is to be consistent in your choice/style.

Some of your variable names are good but some are too short/unclear (cn, rst1 and cmd) and strQuery looks like you might be thinking of using Hungarian notation. See this post for a discussion of Hungarian. The main thing is to be consistent in your choice/style.

Some of your variable names are good but some are too short/unclear (cn, rst1 and cmd) and strQuery looks like you might be thinking of using Hungarian notation. See this post for a discussion of Hungarian. The main thing is to be consistent in your choice/style.

minor fix to the code
Source Link
ChipsLetten
  • 1.2k
  • 5
  • 8
Option Explicit
Public Sub MoveData()
 '**defines the project name as a variable
 Dim fileName As String
 fileName = Worksheets("Cover").Range("B5").Value
 '**defines the path of the CSV summary from BlueBeam
 Dim filePath As String
 filePath = "C:\Users\(users)\Documents\(folder)\"
 '**defines the destination workbook
 Dim currentWB As Workbook
 Set currentWB = ThisWorkbook
 '**connects using ADODB to transfer the data
 Dim dbConn As ADODB.Connection
 Set dbConn = New ADODB.Connection
 
 With dbConn
 .ConnectionString = "Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & filePath _
 & ";Extensions=asc,csv,tab,txt;"
 .Open
 End With
' Added declarations
Dim measurementQueryString As String
Dim notesQueryString As String
Dim keyword1 As String
Dim keyword2 As String
 keyword1 = "some_value"
 measurementQueryString = "SELECT [Measurement] FROM [" & fileName & "] " _
 & "Where Subject LIKE '%" & keyword1 & "%';"
 Call CopyFromFileToRange(dbConn, measurementQueryString, currentWB.Worksheets("Bms").Range("C7"))
 
 keyword2 = "some_value"
 notesQueryString = "SELECT [Notes (C)], [Col Top (C)], [Col Base (C)] FROM [" & fileName & "] " _
 & "Where Subject LIKE '%" & keyword2 & "%'"
 Call CopyFromFileToRange(dbConn, notesQueryString, currentWB.Worksheets("Cols").Range("B7"))
 
 dbConn.Close
 
End Sub
Private Sub CopyFromFileToRange(ByRef dbConn As ADODB.Connection, ByRef queryString As String, ByRef targetRange As Range)
' Opens a recordset using queryString as the source
' Writes the data to targetRange
Dim dataFromCsv As ADODB.Recordset
 Set dataFromCsv = New ADODB.Recordset
 dataFromCsv.Open Source:=queryString, ActiveConnection:=dbConn
 If Not dataFromCsv.EOF Then
 targetRange.CopyFromRecordset dataFromCsv
 Else
 ' No data found
 End If
 
 dataFromCsv.Close
End Sub

Option Explicit
Public Sub MoveData()
 '**defines the project name as a variable
 Dim fileName As String
 fileName = Worksheets("Cover").Range("B5").Value
 '**defines the path of the CSV summary from BlueBeam
 Dim filePath As String
 filePath = "C:\Users\(users)\Documents\(folder)\"
 '**defines the destination workbook
 Dim currentWB As Workbook
 Set currentWB = ThisWorkbook
 '**connects using ADODB to transfer the data
 Dim dbConn As ADODB.Connection
 Set dbConn = New ADODB.Connection
 
 With dbConn
 .ConnectionString = "Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & filePath _
 & ";Extensions=asc,csv,tab,txt;"
 .Open
 End With
' Added declarations
Dim measurementQueryString As String
Dim notesQueryString As String
Dim keyword1 As String
Dim keyword2 As String
 measurementQueryString = "SELECT [Measurement] FROM [" & fileName & "] " _
 & "Where Subject LIKE '%" & keyword1 & "%';"
 Call CopyFromFileToRange(dbConn, measurementQueryString, currentWB.Worksheets("Bms").Range("C7"))
 
 notesQueryString = "SELECT [Notes (C)], [Col Top (C)], [Col Base (C)] FROM [" & fileName & "] " _
 & "Where Subject LIKE '%" & keyword2 & "%'"
 Call CopyFromFileToRange(dbConn, notesQueryString, currentWB.Worksheets("Cols").Range("B7"))
 
 dbConn.Close
 
End Sub
Private Sub CopyFromFileToRange(ByRef dbConn As ADODB.Connection, ByRef queryString As String, ByRef targetRange As Range)
' Opens a recordset using queryString as the source
' Writes the data to targetRange
Dim dataFromCsv As ADODB.Recordset
 Set dataFromCsv = New ADODB.Recordset
 dataFromCsv.Open Source:=queryString, ActiveConnection:=dbConn
 If Not dataFromCsv.EOF Then
 targetRange.CopyFromRecordset dataFromCsv
 Else
 ' No data found
 End If
 
 dataFromCsv.Close
End Sub

Option Explicit
Public Sub MoveData()
 '**defines the project name as a variable
 Dim fileName As String
 fileName = Worksheets("Cover").Range("B5").Value
 '**defines the path of the CSV summary from BlueBeam
 Dim filePath As String
 filePath = "C:\Users\(users)\Documents\(folder)\"
 '**defines the destination workbook
 Dim currentWB As Workbook
 Set currentWB = ThisWorkbook
 '**connects using ADODB to transfer the data
 Dim dbConn As ADODB.Connection
 Set dbConn = New ADODB.Connection
 
 With dbConn
 .ConnectionString = "Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & filePath _
 & ";Extensions=asc,csv,tab,txt;"
 .Open
 End With
' Added declarations
Dim measurementQueryString As String
Dim notesQueryString As String
Dim keyword1 As String
Dim keyword2 As String
 keyword1 = "some_value"
 measurementQueryString = "SELECT [Measurement] FROM [" & fileName & "] " _
 & "Where Subject LIKE '%" & keyword1 & "%';"
 Call CopyFromFileToRange(dbConn, measurementQueryString, currentWB.Worksheets("Bms").Range("C7"))
 
 keyword2 = "some_value"
 notesQueryString = "SELECT [Notes (C)], [Col Top (C)], [Col Base (C)] FROM [" & fileName & "] " _
 & "Where Subject LIKE '%" & keyword2 & "%'"
 Call CopyFromFileToRange(dbConn, notesQueryString, currentWB.Worksheets("Cols").Range("B7"))
 
 dbConn.Close
 
End Sub
Private Sub CopyFromFileToRange(ByRef dbConn As ADODB.Connection, ByRef queryString As String, ByRef targetRange As Range)
' Opens a recordset using queryString as the source
' Writes the data to targetRange
Dim dataFromCsv As ADODB.Recordset
 Set dataFromCsv = New ADODB.Recordset
 dataFromCsv.Open Source:=queryString, ActiveConnection:=dbConn
 If Not dataFromCsv.EOF Then
 targetRange.CopyFromRecordset dataFromCsv
 Else
 ' No data found
 End If
 
 dataFromCsv.Close
End Sub
Source Link
ChipsLetten
  • 1.2k
  • 5
  • 8

The first thing is that you do not seem to be using Option Explicit because there are some variables (strQuery, cmd1 and cmd2) that are not declared. You should always use Option Explicit and this can be turned on in Tools -> Options, on the Editor tab check the "Require Variable Declaration" checkbox. The IDE will add Option Explicit at the top of every new module.

enter image description here

You are currently mixing the "standard" Excel data access methods (cells, ranges, etc) with using sql which makes it harder to keep track of what your code is doing. This can be simplified by using just sql to get data from the csv file. You don't need to read down through the csv file looking for keywords, you can include the keyword in your sql with a WHERE clause. This also means you do not need to open the csv file. In sql the % character is the wildcard for zero or many characters.

If you are retrieving data using ADODB, then you only need to use Recordset, you don't need to use a Command object and a Recordset. If you will be repeatedly opening a recordset and copying the data to a range then you could put that code into a separate procedure. In my code below, I have the CopyFromFileToRange procedure.

Some of your variable names are good but some are too short/unclear (cn, rst1 and cmd) and strQuery looks like you might be thinking of using Hungarian notation. See this post for a discussion of Hungarian. The main thing is to be consistent in your choice/style.

Option Explicit
Public Sub MoveData()
 '**defines the project name as a variable
 Dim fileName As String
 fileName = Worksheets("Cover").Range("B5").Value
 '**defines the path of the CSV summary from BlueBeam
 Dim filePath As String
 filePath = "C:\Users\(users)\Documents\(folder)\"
 '**defines the destination workbook
 Dim currentWB As Workbook
 Set currentWB = ThisWorkbook
 '**connects using ADODB to transfer the data
 Dim dbConn As ADODB.Connection
 Set dbConn = New ADODB.Connection
 
 With dbConn
 .ConnectionString = "Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & filePath _
 & ";Extensions=asc,csv,tab,txt;"
 .Open
 End With
' Added declarations
Dim measurementQueryString As String
Dim notesQueryString As String
Dim keyword1 As String
Dim keyword2 As String
 measurementQueryString = "SELECT [Measurement] FROM [" & fileName & "] " _
 & "Where Subject LIKE '%" & keyword1 & "%';"
 Call CopyFromFileToRange(dbConn, measurementQueryString, currentWB.Worksheets("Bms").Range("C7"))
 
 notesQueryString = "SELECT [Notes (C)], [Col Top (C)], [Col Base (C)] FROM [" & fileName & "] " _
 & "Where Subject LIKE '%" & keyword2 & "%'"
 Call CopyFromFileToRange(dbConn, notesQueryString, currentWB.Worksheets("Cols").Range("B7"))
 
 dbConn.Close
 
End Sub
Private Sub CopyFromFileToRange(ByRef dbConn As ADODB.Connection, ByRef queryString As String, ByRef targetRange As Range)
' Opens a recordset using queryString as the source
' Writes the data to targetRange
Dim dataFromCsv As ADODB.Recordset
 Set dataFromCsv = New ADODB.Recordset
 dataFromCsv.Open Source:=queryString, ActiveConnection:=dbConn
 If Not dataFromCsv.EOF Then
 targetRange.CopyFromRecordset dataFromCsv
 Else
 ' No data found
 End If
 
 dataFromCsv.Close
End Sub
lang-vb

AltStyle によって変換されたページ (->オリジナル) /