In my situation, I have several hundred dBase (.dbf) files that need to be converted.
My code seems to create blank .csv files though.
I have verified that the .dbf files are not corrupt and open fine in OpenOffice Calc (the program I run the macro in).
I've verified that it loops through the source files correctly.
I've verified that it creates the .csv files with the correct names.
I've also verified the Filter Options are correct by manually recording a macro that successfully accomplishes what I need and by comparing them to online samples which apparently work, just not for me when run as a macro.
So I'm not sure where to go from this point. Everything I read online tells me this should be working and I don't really see where the problem is in the code
You'll see that I have two loops. That is because of case sensitivity. Some of my source files are .dbf and some are .DBF. This caused a problem so I had to code for both.
You'll also see I have commented out my original attempt in the last function to convert to .csv, it produced the same results.
Code: Select all
REM ***** BASIC *****
Sub Main
'path = "P:\AIMS Backup and Conversion\SourceFiles\SMM-Field\RedFiles\"
path = "Y:\Data-Projects\AIMS Backup and Conversion\SourceFiles\SMM-Field\" 'Enter your basic path here. You can not list anything from these named directories.
ConvertFiles (path)
End Sub
Sub ConvertFiles (url)
Dim sAns,iAns,a,DorF,oDoc,oSheet,Dname,Col,Row
dim document as object
'MsgBox(url)
oDoc = ThisComponent
oSheet = oDoc.Sheets(0) 'Sheet1
Directory:
sAns = InputBox("Enter directory name." & Chr(13) & Chr(13) & "Examples: documents or documents\embroidery designs"
If sAns = "" then MsgBox "Cancel pressed. Quitting." : End
url = ConvertToURL(url & sAns)
'MsgBox(url)
If Not FileExists(url) then MsgBox "No such directory. Try again." : Goto Directory
DorF = 0
'dorf=0 is files only
ext = "*"
ext1 = InputBox("Enter the desired file type extention. Examples: odt for Writer files or * for all files."
If ext1 = "" then MsgBox("Quitting.") : End
lowExt = ext & "." & ext1
capExt = ext & "." & UCase(ext1)
'MsgBox("cap ext = " + capExt)
LoopFiles:
lCaseUrl = url & "/" & lowExt
uCaseUrl = url & "/" & capExt
'get the name of a dbf file
Dname = Dir(lCaseUrl,DorF)
'loop to process files with lowercase .dbf extension
Do While Dname <> ""
If Dname <> "." And Dname <> ".." then
EndIf
lowerFQN = url & "/" & Dname
'set the .csv version file name for the .dbf
fileNamePart = Left(Dname, (Len(Dname)-4))
Cname = fileNamePart & ".csv"
targetCSVURL = url & "/" & Cname
'MsgBox("targetCSVURL = " & targetCSVURL)
'MsgBox("lowerFQN = " & lowerFQN)
SaveDBFAsCSV (targetCSVURL, Cname)
Dname = Dir
Loop
'loop to process files with uppercase .dbf extension
DName2 = Dir(uCaseUrl, DofF)
Do While Dname2 <> ""
'If Dname <> "." And Dname <> ".." then
'EndIf
'MsgBox(Dname2)
'upperFQN = url & "/" & Dname2
'Dname2 = Dir
'doc = Dname.file
'SaveDBFAsCSV (Dname, doc)
Loop
End
E1:
MsgBox "'" & Cname & "' is an illegal cell name. Try again." : Goto LoopFiles
End Sub
Sub SaveDBFAsCSV (fqn, fName)
'MsgBox(fName)
' MsgBox(fqn)
'Dim Propval(1) as New com.sun.star.beans.PropertyValue
'Propval(0).Name = "FilterName"
'Propval(0).Value = "Text - txt - csv (StarCalc)"
'Propval(1).Name = "FilterOptions"
'Propval(1).Value ="44,34,0,1,1" 'ASCII 59 = ; 34 = "
'Doc = ThisComponent
'FileName = fqn
'FileURL = convertToURL(FileName)
'Doc.StoreAsURL(FileURL, Propval())
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem ----------------------------------------------------------------------
dim args1(2) as new com.sun.star.beans.PropertyValue
args1(0).Name = "URL"
rem --this value represents the target name/csv path/file name
args1(0).Value = fqn
args1(1).Name = "FilterName"
args1(1).Value = "Text - txt - csv (StarCalc)"
args1(2).Name = "FilterOptions"
args1(2).Value = "44,34,ANSI,1,,0,true,true,true"
dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, args1())
End Sub