excel vba convert access file.mdb to file.csv - vba

I have a macro recorded from Excel VBA that extract data from access file.mdb. How do I substitute user prompt this string C:\test.mdb under CommandText = Array(). I would like to have a user prompt different file.mdb every time. what is symbol ` mean in Excel VBA?
Also, is it possible to split each device id to a new file.csv
Sub Macro1()
'
' Macro1 Macro
'
'
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=C:\test.mdb;DefaultDir=C:\;DriverId=25;FIL=MS Access;MaxB" _
), Array("ufferSize=2048;PageTimeout=5;")), Destination:=Range("$A$1")). _
QueryTable
.CommandText = Array( _
"SELECT Program.`Program Name`, Program.`Program Desc`, Program.`Program Unique`, Program.`Program DB`, Operator.`Operator ID`, Operator.`Operator Unique`, `Device Under Test`.`Device ID`, `Device Unde" _
, _
"r Test`.Notes, `Device Under Test`.`Device Under Test Unique`, Data_vD.`Test Unique`, Data_vD.Exclude, Data_vD.`Total Time`, Data_vD.Cycle, Data_vD.`Loop Counter #1`, Data_vD.`Loop Counter #2`, Data_v" _
, _
"D.`Loop Counter #3`, Data_vD.Step, Data_vD.`Step time`, Data_vD.Current, Data_vD.Voltage, Data_vD.Power, Data_vD.`Instantaneous Amps`, Data_vD.`Instantaneous Volts`, Data_vD.`Instantaneous Watts`, Dat" _
, _
"a_vD.`Amp-Hours`, Data_vD.`Watt-Hours`, Data_vD.`Assignable Variable 1`, Data_vD.`Assignable Variable 2`, Data_vD.Mode, Data_vD.`Data Acquisition Flag`" & Chr(13) & "" & Chr(10) & "FROM `C:\test.mdb`.Data_v" _
, _
"D Data_vD, `C:\test.mdb`.`Device Under Test` `Device Under Test`, `C:\test.mdb`.Operator Operator, `C:\test.mdb`.Program Program" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_Query_from_MS_Access_Database"
.Refresh BackgroundQuery:=False
End With
Columns("J:J").Select
ActiveWorkbook.Worksheets("Sheet4").ListObjects( _
"Table_Query_from_MS_Access_Database").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet4").ListObjects( _
"Table_Query_from_MS_Access_Database").Sort.SortFields.Add Key:=Range( _
"Table_Query_from_MS_Access_Database[[#All],[Test Unique]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet4").ListObjects( _
"Table_Query_from_MS_Access_Database").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=-12
Range("I2").Select
ActiveWorkbook.Worksheets("Sheet4").ListObjects( _
"Table_Query_from_MS_Access_Database").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet4").ListObjects( _
"Table_Query_from_MS_Access_Database").Sort.SortFields.Add Key:=Range( _
"Table_Query_from_MS_Access_Database[[#All],[Device Under Test Unique]]"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet4").ListObjects( _
"Table_Query_from_MS_Access_Database").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

Related

Query tables error in VBA

I am fetching data in excel sheet from a website but I'm getting error
object "variable or with block variable not set"
at this part of code. You can find whole code I have tried so far below.
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://portal.amfiindia.com/DownloadNAVHistoryReport_Po.aspx?" & url & "" _
, Destination:=range("$A$1"))
Below is the code I tried so far.
Sub Macro1()
Dim mf As Integer
Dim to_date As String
Dim from_date As String
Dim range As range
Dim url As String
to_date = Format(Sheets("sheet1").Cells(5, 10).Value, "dd-mmm-yyyy")
from_date = Format(Sheets("sheet1").Cells(8, 10).Value, "dd-mmm-yyyy")
mf = Application.WorksheetFunction.VLookup(Sheets("sheet1").ComboBox1.Value,
Worksheets("sheet1").range("A:B"), 2, False)
url = "mf=" & mf & "&tp=1&frmdt=" & to_date & "&todt=" & from_date
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://portal.amfiindia.com/DownloadNAVHistoryReport_Po.aspx?" & url & "" _
, Destination:=range("$A$1"))
.Name = _
"DownloadNAVHistoryReport_Po.aspx?mf=3&tp=1&frmdt=04-Mar-2014&todt=13-Aug-2018"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Columns("A:A").Select
Selection.TextToColumns Destination:=range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
TrailingMinusNumbers:=True
End Sub

Run Time error '1004:, General ODBC ERROR

I have a script which is not running on my system. I am not expert in this and the person who made script is no more with the organisation anymore.
Any assistance on this will be appreciated.
After Doing Debug, the highlighted filed is ".Refresh BackgroundQuery:=False"
Below is the script: -
Sub Run_Customs_Report()
'
' Macro4 Macro
'
'
Sheets("Customs_Report").Select
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=GOMS_MEM;UID=OD173;PWD=Adbu765$;DBQ=MDCGOMP.WORLD;DBA=W;APA=T;EXC=F;FEN=T;QTO=T;FRC=10;FDL=10;LOB=T;RST=T;BTD=F;BNF=F;BAM" _
), Array( _
"=IfAllSuccessful;NUM=NLS;DPM=F;MTS=T;MDI=F;CSR=F;FWC=F;FBS=64000;TLO=O;MLD=0;ODA=F;STE=F;TSZ=8192;" _
)), Destination:=Range("$A$1")).QueryTable
.CommandText = Array( _
"SELECT TO_CHAR (D.PRINT_PART_NO) AS ""Print Part"",A.CATALOG_DESC AS ""Descripcion"",B.COUNTRY_OF_ORIGIN AS ""Country"",B" _
, _
".Packing_list_no AS ""Packing List"",TO_CHAR (A.order_no) AS ""Order"", A.Customer_PO_NO AS ""PO"", ROUND(A.Unit_Price) AS ""Unit" _
, _
" Price"", SUM (B.QTY_SHIPPED) AS ""Qty"", ROUND(SUM (A.unit_Price * B.QTY_SHIPPED)) AS ""Ext Total"", TO_CHAR (B.INVOICE_NO) AS" _
, _
" ""Manifest"", TO_CHAR(B.INVOICE_DATE) AS ""Date"", C.note_text AS ""GOMS Ref"", TO_CHAR (B.TRACKING_NO) AS ""Tracking No"", TO_CHAR" _
, _
" (A.SHIP_TO_ABBR) AS ""Ship To Location"" FROM oeorder_detail A INNER JOIN oeorder_shipping B ON A.part_no = B.part_n" _
, _
"o AND A.order_no = B.order_no AND A.line_no = B.line_no INNER JOIN OECUSTOMER_ORDER_NOTES C ON A.order_no = C.order" _
, _
"_no INNER JOIN PART_DESCRIPTION D ON A.part_no = D.part_no AND A.SHIP_TO_ABBR IN ('54827','54734','55945','56169','" _
, _
"55897','56086') AND (TRUNC (SYSDATE) - TRUNC (INVOICE_DATE)) = '1' AND B.tracking_no IS NOT NULL AND note_no = '1' " _
, _
"AND LINE_NO is null GROUP BY D.PRINT_PART_NO,A.CATALOG_DESC,B.COUNTRY_OF_ORIGIN,B.Packing_list_no,A.order_no," _
, _
"Customer_PO_NO,A.Unit_Price,B.INVOICE_NO,B.INVOICE_DATE,C.note_text, B.TRACKING_NO, A.SHIP_TO_ABBR ORDER BY A.Ship_" _
, "To_Abbr, B.INVOICE_NO")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_ExternalData_1"
.Refresh BackgroundQuery = False
end with
end sub
The error is generated by the .Refresh line because it's that line which triggers the execution of the SQL query.
Whilst I find the use of Array() a bit strange, if nothing has changed in the code, I would check with your database administrator whether the user account OD173 is still active.

Excel VBA - I want to insert a date in a 'Get external data' query

I have this Sub with which I receive data from external connection. I already specified a date range :
((infactln.dtransact>{d '2015-09-01'}) AND (infact.dtransact<{d '2015-09-30'}))
I want this sub to give the user the possibility to change this date range without going in "Data - Connections - Properties"
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=Visual FoxPro Tables;UID=;;SourceDB=\\serverName\data.dbc;
SourceType=DBC;Exclusive=No;Background" _
), Array("Fetch=Yes;Collate=Machine;Null=Yes;Deleted=Yes;")),
Destination:= _Range("$A$1")).QueryTable.CommandText = Array(
_"SELECT infact.ctransid, infact.ccode, infactln.dtransact,
infactln.ccode, infactln.cdesc, infactln.bqte, infactln.bmontant,
infactln.bcoutant" & Chr(13) & "" & Chr(10) & "FROM infact infact,
infactln infactln" & Chr(13) & "" & Chr(10) & "WHERE infact.kid =" _
, _" infactln.cparentid AND ((infactln.dtransact>{d '2015-09-01'}) AND
(infact.dtransact<{d '2015-09-30'}))" _)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_Query_from_Visual_FoxPro_Tables"
.Refresh BackgroundQuery:=False
End With
You can (and should) use Format function:
https://msdn.microsoft.com/en-us/library/office/gg251755.aspx
Than you just give the user opportunity to specify specific dates in some cells, let's say these are "A1" and "B1". You just substitute the date values in your query with
" infactln.cparentid AND ((infactln.dtransact>{d '" & Format(Cells(1, "A"), "yyyy-MM-dd") & "'}) AND
(infact.dtransact<{d '" & Format(Cells(1, "B"), "yyyy-MM-dd") & "'}))"

.refresh BackgroundQuery:=False error 1004

i'm fighting with a problem..
i've got a VBA macro in excel 2013 (made in 2007 and worked fine in 2010)
it's scripted in SQL.
here is a bit of the code where the error is
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"ODBC;DRIVER=SQL Server Native Client 10.0;SERVER=APP14A\ISAHSERVER;UID=reader;PWD=reader;;DATABASE=ProduktieDB;", Destination _
:=Range("$A$7")).QueryTable
.CommandText = Array( _
"SELECT T_DossierMain.OrdNr, T_DossierDetail.DetailCode, T_DossierDetail.Description, T_DossierDetail.PartCode, T_DossierDetail.CalcQty, T_DossierDetail.DiscPerc, T_DossierDetail.CurrPrice" & Chr(13) & "" & Chr(10) & "FROM ProduktieDB.dbo.T_DossierDetail T_DossierDetail, ProduktieDB" _
, _
".dbo.T_DossierMain T_DossierMain" & Chr(13) & "" & Chr(10) & "WHERE T_DossierDetail.DossierCode = T_DossierMain.DossierCode AND ((T_DossierMain.OrdNr= '" & VariableOrderNo & "' ))" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_Hoofdregels_Ophalen"
.Refresh BackgroundQuery:=False
End With
If IsEmpty(Range("A8").Value) Then
MsgBox "De order bestaat niet of heeft geen regels!"
Exit Sub
End If
so the problem is that i'm getting the error on the line ".refresh BackgroundQuery:=False
and if i remove that line, it will keep printing stuff
help?
regards,
michael
EDIT: i've found the problem.. this macro was made in 2007 so the only thing i had to do was changing the ".PreserveFormatting = False > True
thanks anyway =)

Can I replace Array with constant?

I am using VBA in Excel to make query and I want replace the
St" _
), Array( _
"efl\zv162_part1.xls
with constant part1
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=Excel Files;DBQ=\\St" _
), Array( _
"efl\zv162_part1.xls;DefaultDir=cesta;DriverId=1046;FIL=excel 12.0;MaxBufferSize=2048;PageTimeout=5;" _
)), Destination:=Range("$A$1")).QueryTable
.CommandText = Array( _
"SELECT `zv162_part1$`.F2, `zv162_part1$`.F4, `zv162_part1$`.F5, `zv162_part1$`.F6, `zv162_pa" _
, _
"rt1$`.F7, `zv162_part1$`.F8, `zv162_part1$`.F9, `zv162_part1$`.F10, `zv162_part1$`.F11, `zv162_part1$`.F12, `zv162_part1$`.F13, `zv162_part1$`.F14, `zv162_part1$`.F15, `zv162_part1$`.F16, `z" _
, _
"v162_part1$`.F17, `zv162_part1$`.F18, `zv162_part1$`.F19, `zv162_part1$`.F20" & Chr(13) & "" & Chr(10) & "FROM `zv162_part1$` `zv162_part1$`" & "WHERE `zv162_part1$`.F2 <> Null" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_Query_from_Excel_Files13"
.Refresh BackgroundQuery:=False
End With
Thank you for any response!
I add whole command for query
Try this
part1 = "stefl\zv162_part1.xls"
With ActiveSheet.ListObjects.Add( _
SourceType:=0, _
Source:=Array(Array("ODBC;DSN=Excel Files;DBQ=" & _
part1 & _
";DefaultDir=cesta;DriverId=1046;FIL=excel 12.0;MaxBufferSize=2048;PageTimeout=5;") _
), Destination:=Range("$A$1")).QueryTable