Save As CSV Macro creates blank CSV

[FrustratedInFresno]

I have customized some code I've found on this and other sites to save all files from an entered subfolder with an entered extension as a .csv.
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

[FJCC]

You read all of the file names in the selected directory but at no point do you open those files. Every call to SaveDBFAsCSV saves the current file, ThisComponent, with a new file name. What you need to do is use the URLs of the file names with the function
StarDesktop.loadComponentFromURL()
to open the files and then use the storeToURL() method of that file to save it as a csv. Check out those two methods and don't hesitate to ask if you need more detailed help.

[FrustratedInFresno]

Thanks for the reply, that has put me on the right path but I've encountered a cryptic error:
Type: com.sun.star.lang.IllegalArgumentException
cannot coerce argument type during corereflection call
Obviously one or more of my arguments are wrong but the document argument should work right?

Code: Select all

Sub OpenFileSaveAsCSV (sourceURL, csvURL, csvName)
	'MsgBox(sourceURL)
	'MsgBox(csvURL)
	'MsgBox(csvName)

	Dim document   as object
	Dim Dummy() 'An (empty) array of PropertyValues
	rem ----------------------------------------------------------------------
	rem open the source file
	document = StarDesktop.loadComponentFromURL(sourceURL, "_blank", 0, Dummy)
	
	rem ----------------------------------------------------------------------
	rem save the source file as a csv by the same name
	Dim dispatcher as object
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	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 = csvURL
	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