I have googled and found the select * into text “filename” from “table”. But no easy/simple way of running it in a macro I have tried several examples but they make no sense to me as I’m not great with coding. Once the macro works I going to assign it to a button on a form if that makes any difference.
I’m running LibreOffice Base 4.1 running on Windows 7.
Thanks in advance
One of my exercises was to export all of the tool information to load into a special query in our ERP to determine when the tools have been used if ever.
So I did the query and wrote to csv file.
You’ll notice some extraneous redundant code but I tried several things that I left behind.
2 export examples below - the second one I was creating labels and exported to CSV and then opened Excel and prepared the file for a Word Doc mail-merge… I haven’t done that in Calc or Writer if possible, but this worked to print labels.
Sub ERP_JOBMOUsed_out()
' Purpose: to export the Query JOBMOUsed to a text file convert to XLS and ready to import to Global Shop
' to table X_JOB_WUSEDMO for crystal report to identify tools used and not used in jobs in history
Dim oSvc as object
Dim sROUTER, sWORKGROUP, sASSYCATEGORY, sAssyID, sJobID, sJobName, sJobMO as string
'''' write transaction to text file for ERP import inventory issue
Dim sOutFilename as string
Dim nOutFileNum as integer
Dim sOutRileRoot, sOutDataLine as string
sOutFileRoot = ConvertFromURL(getAppRoot)
sOutFilename = sOutFileRoot & "appstuff\invty\ERPImports\TOOLDB-JobMOUsed.csv"
nOutFileNum = FreeFile()
' Open output file and write data
Open sOutFilename For Output Access Read Write As #nOutFileNum
sOutDataLine = "ROUTER, WORKGROUP, ASSYCATEGORY, AssyID, JobID, JobName, JobMO "
' Write heading line to csv
Print #nOutFileNum, sOutDataLine
' sql = "SELECT * FROM `JOBMOUsed` Where assyID <> 0 "
' sql = "SELECT * "
sql = "SELECT `whereused`.`AssyCategory`, "
sql = sql + "`whereused`.`AssyID`, "
sql = sql + "`whereused`.`JobID`, "
sql = sql + "`machine_jobs`.`JobName`, "
sql = sql + "`machine_jobs`.`MO` AS `JobMO`, "
sql = sql + "`assembly_category`.`categoryName` "
sql = sql + " FROM `whereused` AS `whereused`, `machine_jobs` AS `machine_jobs`, `assembly_category` AS `assembly_category` "
sql = sql + " WHERE `whereused`.`JobID` = `machine_jobs`.`JobID` AND `whereused`.`AssyCategory` = `assembly_category`.`categoryID` "
Result = SQLquery(sql)
Result.next()
while Result.next()
sASSYCATEGORY = Result.getString(1)
sAssyID = Result.getString(2)
sJobID = Result.getString(3)
sJobName = Replace(Result.getString(4), ",", " ")
sJobName = Replace(sJobName, Chr(34), " ")
sJobMO = Result.getString(5)
if Len(sJobMO) < 5 then
sROUTER = STRING(5 - Len(sJobMO), "0") & Result.getString(5)
' sROUTER = String( 5 - Len(sJobMO), Chr(48))
else
sROUTER = sJobMO
end if
sWORKGROUP = Result.getString(6)
sOutDataLine = "*" &s & "*" & "," & sPart &","& sDesc1 &","& sCabDwrPos &","& sMfg &","& sMfg_Part
sOutDataLine = Chr(34) & sROUTER & Chr(34) & "," & sWORKGROUP & "," & sASSYCATEGORY & "," & sAssyID & "," & sJobID & "," & sJobName & "," & sJobMO
' Write detail line to csv
Print #nOutFileNum, sOutDataLine
wend
SQLclose()
close #nOutFileNum
' took out the excel conversion - GSS GAB is working with CSV file
'Dim sOutFilexls as string
'
'sOutFilexls = sOutFileRoot & "appstuff\invty\ERPImports\TOOLDB-JobMOUsed.xls"
'if fileexists(sOutFilexls) then
' Kill sOutFilexls
'end if
'sExcelFile = sOutFileRoot & "appstuff\invty\ERPImports\TOOLDB-JobMOUsed_MACRO.xls"
'
' ' Shell execute
' oSvc = createUnoService("com.sun.star.system.SystemShellExecute")
' Rem File:
' oSvc.execute(ConvertToUrl(sExcelFile ), "", 0)
End Sub
Sub ERP_tool_Label()
Dim oSvc as object
Dim sDocumentRoot as string
Dim sDocumentPath as string
Dim sDocFilename, sDocFileBackup as string
Dim nothing
sDocumentRoot = ConvertFromURL(getAppRoot)
sDocumentPath = sDocumentRoot & "BarcodeLabels\"
sDocumentPath = sDocumentRoot & "appstuff\BarcodeLabels\"
sDocFilename = sDocumentPath & "ToolBarcode_Merge00.doc"
sDocFileBackup = sDocumentPath & "ToolBarcode_Merge00_backup.doc"
' msgbox cFile
' msgbox sDocFilename
' msgbox sDocFileBackup
' msgbox copyPath
FileCopy sDocFileBackup, sDocFilename
Dim sCab as String
Dim nDwr, nPos as Integer
Dim sCabDwrPos as String
prefix = ThisComponent.Drawpage.Forms.getByIndex(0).getByName("Tool Data Grid").getByName("Tool Class").Boundfield.Int
suffix = ThisComponent.Drawpage.Forms.getByIndex(0).getByName("Tool Data Grid").getByName("Tool Number").CurrentValue
sCab = ThisComponent.Drawpage.Forms.getByIndex(0).getByName("Tool Data Grid").getByName("CabinetID").CurrentValue
nDwr = ThisComponent.Drawpage.Forms.getByIndex(0).getByName("Tool Data Grid").getByName("Drawer").CurrentValue
nPos = ThisComponent.Drawpage.Forms.getByIndex(0).getByName("Tool Data Grid").getByName("Position").CurrentValue
sCabDwrPos = sCab & "-" & CStr(nDwr) & "-" & CStr(nPos)
If suffix = nothing then
msgbox "Select a tool from the grid first.",6,"Error"
else
' First Clear the temp datafile for the inventory
sql = "delete from `barcode_print1` "
SQLcommand(sql)
SQLclose
sql = "INSERT INTO `barcode_print1` (`Tool Class`, `Tool Number`)"
sql = sql & " VALUES ( " & prefix & "," & suffix & ")"
SQLcommand(sql)
SQLclose()
' 1 2 3 4 5 6 7
Dim sPart, sDesc1, sDesc2, sDesc3, sCode_sort, sMfg, sMfg_part as string
If sCab = "" then
msgbox "The label will print but the current Tool does NOT have a Cabinet Location Specified! ",6,"Error"
' sql = "SELECT part, desc1, desc2, desc3, code_sort, mfg, mfg_part FROM `barcode_printing` Where part <> '' "
sql = "SELECT if( IsNull( `ERP_Code` ), `barcode_print1`.`Tool Number`, "
sql = sql + " `ERP_Code` ) AS `part`, "
sql = sql + " if( IsNull( `desc1` ), "
sql = sql + " `Inventory Item Name`, `desc1` ) AS `desc1`, "
sql = sql + " if( IsNull( `desc2` ), '', `desc2` ) AS `desc2`, "
sql = sql + " if( IsNull( `desc3` ), '', `desc3` ) AS `desc3`, "
sql = sql + " '' AS `code_sort`, "
sql = sql + " `manufacturer_table`.`Manufacturer Name` AS `mfg`, "
sql = sql + " `tools__milling_dept`.`Mfg Part Number` AS `mfg_part`, "
sql = sql + " `tools__milling_dept`.`Drawer` AS `drawer`, "
sql = sql + " `tools__milling_dept`.`Position` AS `position` "
sql = sql + " FROM { OJ `tools__milling_dept` AS `tools__milling_dept` "
sql = sql + " LEFT OUTER JOIN `inventory_erp_imported` AS `inventory_erp_imported` "
sql = sql + " ON `tools__milling_dept`.`ERP_Code` = `inventory_erp_imported`.`part` }, "
sql = sql + " `barcode_print1` AS `barcode_print1`, "
sql = sql + " `manufacturer_table` AS `manufacturer_table`, "
sql = sql + " `prefix_name` AS `prefix_name` "
sql = sql + " WHERE `tools__milling_dept`.`Tool Class` = `barcode_print1`.`Tool Class` "
sql = sql + " AND `tools__milling_dept`.`Tool Number` = `barcode_print1`.`Tool Number` "
sql = sql + " AND `manufacturer_table`.`Manufacturer ID` = `tools__milling_dept`.`Manufacturer ID` "
sql = sql + " AND `prefix_name`.`Prefix` = `barcode_print1`.`Tool Class` "
'sql = "SELECT * FROM `barcode_printing` Where part <> '' "
Else
' sql = "SELECT part, desc1, desc2, desc3, code_sort, mfg, mfg_part FROM `barcode_printing` Where part <> '' "
sql = "SELECT if( IsNull( `ERP_Code` ), `barcode_print1`.`Tool Number`, `ERP_Code` ) AS `part`, "
sql = sql + " if( IsNull( `desc1` ), `Inventory Item Name`, `desc1` ) AS `desc1`, "
sql = sql + " if( IsNull( `desc2` ), '', `desc2` ) AS `desc2`, "
sql = sql + " if( IsNull( `desc3` ), '', `desc3` ) AS `desc3`, "
sql = sql + " `cabinet`.`CabinetName` AS `code_sort`, "
sql = sql + " `manufacturer_table`.`Manufacturer Name` AS `mfg`, "
sql = sql + " `tools__milling_dept`.`Mfg Part Number` AS `mfg_part`, "
sql = sql + " `tools__milling_dept`.`Drawer` AS `drawer`, "
sql = sql + " `tools__milling_dept`.`Position` AS `position` "
sql = sql + " FROM { OJ `tools__milling_dept` AS `tools__milling_dept` "
sql = sql + " LEFT OUTER JOIN `inventory_erp_imported` AS `inventory_erp_imported` "
sql = sql + " ON `tools__milling_dept`.`ERP_Code` = `inventory_erp_imported`.`part` }, "
sql = sql + " `barcode_print1` AS `barcode_print1`, "
sql = sql + " `cabinet` AS `cabinet`, "
sql = sql + " `manufacturer_table` AS `manufacturer_table`, "
sql = sql + " `prefix_name` AS `prefix_name` "
sql = sql + " WHERE `tools__milling_dept`.`Tool Class` = `barcode_print1`.`Tool Class` "
sql = sql + " AND `tools__milling_dept`.`Tool Number` = `barcode_print1`.`Tool Number` "
sql = sql + " AND `cabinet`.`CabinetID` = `tools__milling_dept`.`CabinetID` "
sql = sql + " AND `manufacturer_table`.`Manufacturer ID` = `tools__milling_dept`.`Manufacturer ID` "
sql = sql + " AND `prefix_name`.`Prefix` = `barcode_print1`.`Tool Class` "
'sql = "SELECT * FROM `barcode_printing` Where part <> '' "
end if
On Error Goto Error_ERP_Tool_Label_Mfg:
Result = SQLquery(sql)
Result.next()
sPart = Result.getString(1)
sDesc1 = Result.getString(2) & " " & Result.getString(3) & " " & Result.getString(4)
sDesc1 = Replace(sDesc1, Chr$(34)," ")
sDesc1 = Replace(sDesc1, ","," ")
' sDesc2 = Result.getString(3)
' sDesc3 = Result.getString(4)
sCode_sort = Result.getString(5) & "-" & Format(nDwr,"00") & "-" & Format(nPos,"00")
sMfg = Result.getString(6)
If sMfg = "" then sMfg = " "
sMfg_Part = Result.getString(7)
If sMfg_Part = "" then sMfg_Part = " "
SQLclose()
On Error Goto 0
'''' write transaction to text file for ERP import inventory issue
Dim sOutFilename as string
Dim nOutFileNum as integer
Dim sOutRileRoot, sOutDataLine as string
sOutFileRoot = ConvertFromURL(getAppRoot)
' ConvertToURL(CurDir)
sOutFilename = sOutFileRoot & "appstuff\BarcodeLabels\ERP_Parts2.csv"
sOutFilexls = sOutFileRoot & "appstuff\BarcodeLabels\ERP_Parts2.xls"
if fileexists(sOutFilexls) then
Kill sOutFilexls
end if
sExcelFile = sOutFileRoot & "appstuff\BarcodeLabels\ERP_Parts2-0.xls"
nOutFileNum = FreeFile()
' Open output file and write data
Open sOutFilename For Output Access Read Write As #nOutFileNum
' Part# , Rev, Locn, Qty , REF , LOT, BIN, HEAT,SERIAL, Issue, No Drop, Drop-Suffix, Drop-Qty
'sOutDataLine = "part, onhand, onpo, reorder, minimum, desc1, desc2, desc3, code_sort, mfg, mfg_part"
sOutDataLine = "part,partnum,desc1,code_sort,mfg,mfg_part"
' Write heading line to csv
Print #nOutFileNum, sOutDataLine
'sOutDataLine = sPart &","& "0" &","& "0" &","& "0" &","& "0" &","& sDesc1 &","& sDesc3 &","& sDesc3 &","& sCode_Sort &","& sMfg &","& sMfg_Part
sOutDataLine = "*" &sPart & "*" &","&sPart &","& sDesc1 &","& sCabDwrPos &","& sMfg &","& sMfg_Part
' Write detail line to csv
Print #nOutFileNum, sOutDataLine
sOutDataLine = "," &",blank" &"," &","
Print #nOutFileNum, sOutDataLine
close #nOutFileNum
' Shell execute
oSvc = createUnoService("com.sun.star.system.SystemShellExecute")
Rem File:
oSvc.execute(ConvertToUrl(sExcelFile ), "", 0)
' Shell execute
oSvc = createUnoService("com.sun.star.system.SystemShellExecute")
Rem File:
oSvc.execute(ConvertToUrl(sDocFilename ), "", 0)
end if
Exit Sub
Error_ERP_Tool_Label_Mfg:
MsgBox "Manufacturer ID must be specified to Print Labels"
SQLclose()
End Sub
'And while you are at it, I threw in an import I did from an outside source to load part numbers.
sub importCSV_Router
Form = ThisComponent.Drawpage.Forms.getByIndex(0)
ProgramRoot = ConvertToURL(getAppRoot)
importURLfile = ProgramRoot + “appstuff/invty/ERPImports/RouterListImport.csv” ’ use / slash
ProgramRoot = ConvertFromURL(getAppRoot)
importfile = ProgramRoot + “appstuff\invty\ERPImports\RouterListImport.csv” ’ use \ slash
importfile = ReplaceWithSubstring(importfile,"","\")
if fileExists(importURLfile) then
sql = “LOAD DATA LOCAL INFILE '”
sql = sql + importfile + “’ INTO TABLE mo FIELDS TERMINATED BY "
sql = sql + “’,’ OPTIONALLY ENCLOSED BY '””’ LINES TERMINATED BY ‘\r\n’ IGNORE 1 LINES"
‘’ sql = “LOAD DATA LOCAL INFILE ‘S:\_tooldb\appstuff\invty\RouterListImport.csv’ INTO TABLE mo FIELDS TERMINATED BY ‘,’ OPTIONALLY ENCLOSED BY '”"’ LINES TERMINATED BY ‘\r\n’ IGNORE 1 LINES"
SQLcommand(sql)
SQLclose
Form.reload
Kill importURLfile
msgbox "CSV import complete"
end if
end sub
I wanted a generic routine, and this is what I came up with:
Option Explicit
Sub DBOpen(Optional poEvent As Object)
If GlobalScope.BasicLibraries.hasByName(“Access2Base”) Then
GlobalScope.BasicLibraries.loadLibrary(“Access2Base”)
End If
Call Application.OpenConnection(ThisDatabaseDocument)
End Sub
Sub GenCSV 'Export a table as a CSV file
Dim ThisDB, RS as Object
Dim FNum as Integer
Dim FName, FVal, WLine, TabName, SQL as String
Dim I, Count as Integer
FName = InputBox(“Enter path where CSV file should go, e.g. C:\Sales”, “CSV Generator”, “C:\Sales”)
If FName = “” then
Exit Sub
End If
If Right(FName, 1) <> “” then
FName = FName & “”
End If
TabName = InputBox(“Enter table name, e.g. Products”, “CSV Generator”, “Products”)
If TabName = “” then
Exit Sub
End If
FName = FName & TabName & “.csv”
FNum = FreeFile()
Open FName for Output Access Read Write As #FNum
SQL = "Select * from " & TabName
Set ThisDB = Application.CurrentDb
Set RS = ThisDB.OpenRecordset(SQL)
WLine = “”
For I = 0 to RS.Fields.Count-1
WLine = WLine & “”"" & RS.Fields(I).Name & “”","
Next
Print #FNum, Left(WLine, Len(WLine)-1) 'Write header line to CSV, removing the final comma
Count = 0
while not RS.EOF
WLine = “”
Count = Count+1
For I = 0 to RS.Fields.Count-1
If IsNull(RS.Fields(I).Value) then
FVal = ""
Else
FVal = RS.Fields(I).Value
End If
WLine = WLine & """" & FVal & ""","
Next
Print #FNum, Left(WLine, Len(WLine)-1) 'Write detail line to CSV, removing the final comma
RS.MoveNext
wend
close #FNum
MsgBox Count & " records processed."
End Sub
============
When I save this I lose the line breaks unless there’s a blank line! If someone tells me how to get round that I’ll try again!