PDA

View Full Version : Convert from Excel to DBF


ABC123

Bill Parker
11-10-2005, 11:08 PM
This function will convert data to DBF format. In my experience, if there are multiple header lines, a balnk row and then data columns, the top row will be used as column headers and everything else will be data. The FromCell parameter might be used to adjust for this.


Function p_Excel_to_Dbf as L(excel_file as C, dbf_file as C, FromCell="A1", ToCell="")
'DESCRIPTION:Save Excel as DBF format. Default From/To is all data, e.g. A1 to end. ABD path assumed if no path specified.

' Set defaults/validate *****************************************
p_Excel_to_Dbf = .f.
if excel_file="" .or. dbf_file=""
ui_msg_box("Excel to DBF", "File name not specified.",UI_NO_SYMBOL)
exit function
end if

if file.filename_parse(excel_file,"d") = "" ' no path (drive) specified
excel_file = p_DataPath() +excel_file
end if
if file.filename_parse(dbf_file,"d") = ""
dbf_file = p_DataPath() +dbf_file
end if

if FromCell = ""
FromCell = "A1"
end if
xlLastCell = 11

' start Excel **************************************************
Dim xlApp as p
xlApp = ole.create("Excel.Application")
'xlApp.Visible = .T. ' just use in testing
'debug(1)

xlApp.Workbooks.Open(excel_file)
xlApp.displayalerts = .f.

if ToCell = ""
lastrow = xlApp.Activecell.SpecialCells(xlLastCell).Row
lastcol = xlApp.Activecell.SpecialCells(xlLastCell).Column
ToCell = chr(lastcol+64)+lastrow
end if

'xlApp.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select()
xlApp.Range(FromCell +":" +ToCell).Select()

xlApp.Selection.Columns.AutoFit() ' make all text visible. export only gets what is visible.


' ***** save new table *****
xlDBF4 = 11
xlApp.ActiveWorkbook.SaveAs(dbf_file, xlDBF4, .f.)

xlApp.ActiveWindow.close(.f.) ' so don't get prompt to save changes
clipboard.Clear_Data() ' because large data can result in windows question to user

xlApp.Quit()

delete xlApp
p_Excel_to_Dbf = .t.

END FUNCTION

I don't show the p_DataPath() function here, but it just gets the path to the server ADB file even if the user is shadowed.

Bill.

csda1
11-11-2005, 09:02 AM
Hi Bill,

A small, minor problems with your code. You left out your function "p_datapath()". (I just saw the thread in the A5 forum - Gosh, you miss 1 day at a client and you get behind in your thread reading:) ! But easily created as in


FUNCTION p_datapath AS C()
p_datapath=IF(trim(a5.Get_Path())="",a5.Get_Master_Path(),a5.Get_Path())
END FUNCTION

Something I typically do is when a blank filename is given, I normally prompt for the filename with a file dialog. Thus, I would make both filename parameters default to ""

Also, instead of returning True or False, I would return number of records imported, with negative numbers to indicate errors. This is potentially a more useful return.

Bill Parker
11-11-2005, 12:12 PM
Ira, I think if the function were to prompt for file names, then the dbf filename would need to be returned on completion. Otherwise calling routine would not know what got converted to what.

I normally customize the ui_get_file() dialog with title, default path, etc. which would then need to be passed to the conversion routine if the dialog were displayed there. I did not want to mess with that for my own use, but your thought is a good one for a generic capability.

Here is the revision.

Function p_Excel_to_Dbf as C(excel_file="", dbf_file="", FromCell="A1", ToCell="")
'DESCRIPTION:Save Excel as DBF format. Default From/To is all data, e.g. A1 to end. ABD path assumed if no path specified. Return is saved DBF filename or blank.

' Set defaults/validate *****************************************
p_Excel_to_Dbf = ""
if file.filename_parse(excel_file,"e") <> ".xls"
excel_file = ui_get_file("Select spreadsheet to convert to DBF","Excel(*.xls)",p_DataPath(),"X")
if excel_file = ""
ui_msg_box("Excel to DBF", "No spreadsheet specified.",UI_NO_SYMBOL)
exit function
end if
end if

if file.filename_parse(dbf_file,"e") <> ".dbf"
dbf_file = file.filename_parse(excel_file,"dpn") +".dbf"
dbf_file = ui_get_file("Select output DBF file","Table(*.dbf)",dbf_file)
if dbf_file = ""
ui_msg_box("Excel to DBF", "No output table specified.",UI_NO_SYMBOL)
exit function
elseif file.exists(dbf_file)
vReplyN = ui_msg_box("Excel to DBF", "Output file already exists." +crlf() +dbf_file +crlf(2) +"Overwrite existing file?",UI_QUESTION_SYMBOL+UI_YES_NO_CANCEL)
if vReplyN <> UI_YES_SELECTED
exit function
end if
end if
end if

if file.filename_parse(excel_file,"d") = "" ' no path (drive) specified
excel_file = p_DataPath() +excel_file
end if
if file.filename_parse(dbf_file,"d") = ""
dbf_file = p_DataPath() +dbf_file
end if

if FromCell = ""
FromCell = "A1"
end if
xlLastCell = 11

' start Excel **************************************************
Dim xlApp as p
xlApp = ole.create("Excel.Application")
'xlApp.Visible = .T. ' just use in testing
'debug(1)

xlApp.Workbooks.Open(excel_file)
xlApp.displayalerts = .f.

if ToCell = ""
lastrow = xlApp.Activecell.SpecialCells(xlLastCell).Row
lastcol = xlApp.Activecell.SpecialCells(xlLastCell).Column
ToCell = chr(lastcol+64)+lastrow
end if

'xlApp.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select()
xlApp.Range(FromCell +":" +ToCell).Select()

xlApp.Selection.Columns.AutoFit() ' make all text visible. export only gets what is visible.


' ***** save new table *****
xlDBF4 = 11
xlApp.ActiveWorkbook.SaveAs(dbf_file, xlDBF4, .f.)

xlApp.ActiveWindow.close(.f.) ' so don't get prompt to save changes
clipboard.Clear_Data() ' because large data can result in windows question to user

xlApp.Quit()

delete xlApp
p_Excel_to_Dbf = dbf_file

END FUNCTION

Bill.

Bill Parker
11-12-2005, 10:47 AM
Well, maybe third time is the charm. while I was in this, it seemed a good idea to add a Sheet parameter for those that might need it. Remember, the conversion to DBF can only do 1 sheet at a time. Also note that in A5v5 and A5v7 the sheet name can be used vs. the sheet index number. But in v6 only the sheet index number can be used.


'Date Created: 09-Nov-2005 03:29:13 PM
'Last Updated: 12-Nov-2005 09:09:25 AM
'Created By : Bill Parker
'Updated By : Bill Parker
Function p_Excel_to_Dbf as C(excel_file="", dbf_file="", FromCell="A1", ToCell="", Sheet=1 as A)
'DESCRIPTION:Save Excel as DBF format. ABD file path assumed if no path specified, blank file=prompt. Default From/To is all data, e.g. A1 to end. Default Sheet=1 (sheet index), can use sheet name, e.g. "MySheet". Return is saved DBF filename or blank.
' Sheet name works in A5v5 and v7, but gives error in v6.

' Set defaults/validate *****************************************
p_Excel_to_Dbf = ""
if file.filename_parse(excel_file,"e") <> ".xls"
excel_file = ui_get_file("Select spreadsheet to convert to DBF","Excel(*.xls)",p_DataPath(),"X")
if excel_file = ""
ui_msg_box("Excel to DBF", "No spreadsheet specified.",UI_STOP_SYMBOL)
exit function
end if
end if

if file.filename_parse(dbf_file,"e") <> ".dbf"
dbf_file = file.filename_parse(excel_file,"dpn") +".dbf"
dbf_file = ui_get_file("Select output DBF file","Table(*.dbf)",dbf_file)
if dbf_file = ""
ui_msg_box("Excel to DBF", "No output table specified.",UI_STOP_SYMBOL)
exit function
elseif file.exists(dbf_file)
vReplyN = ui_msg_box("Excel to DBF", "Output file already exists." +crlf() +dbf_file +crlf(2) +"Overwrite existing file?",UI_QUESTION_SYMBOL+UI_YES_NO_CANCEL)
if vReplyN <> UI_YES_SELECTED
exit function
end if
end if
end if

if file.filename_parse(excel_file,"d") = "" ' no path (drive) specified
excel_file = p_DataPath() +excel_file
end if
if file.filename_parse(dbf_file,"d") = ""
dbf_file = p_DataPath() +dbf_file
end if

if FromCell = ""
FromCell = "A1"
end if
xlLastCell = 11

if typeof(Sheet) = "N"
' do nothing
elseif typeof(Sheet) = "C"
if Sheet = "" ' in v6 only numeric sheet index works.
delete Sheet
Dim Sheet as N
Sheet = 1
end if
else
ui_msg_box("Excel to DBF", "Invalid Sheet specification. Must be numeric or character.",UI_STOP_SYMBOL)
exit function
end if

' start Excel **************************************************
Dim xlApp as p
xlApp = ole.create("Excel.Application")
'xlApp.Visible = .T. ' just use in testing
'debug(1)

xlApp.Workbooks.Open(excel_file)
xlApp.displayalerts = .f.

xlApp.Sheets(Sheet).Select()

if ToCell = ""
lastrow = xlApp.Activecell.SpecialCells(xlLastCell).Row
lastcol = xlApp.Activecell.SpecialCells(xlLastCell).Column
ToCell = chr(lastcol+64)+lastrow
end if

'xlApp.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select()
xlApp.Range(FromCell +":" +ToCell).Select()

xlApp.Selection.Columns.AutoFit() ' make all text visible. export only gets what is visible.

' ***** save new table *****
xlDBF4 = 11
xlApp.ActiveWorkbook.SaveAs(dbf_file, xlDBF4, .f.)

xlApp.ActiveWindow.close(.f.) ' so don't get prompt to save changes
clipboard.Clear_Data() ' because large data can result in windows question to user

xlApp.Quit()

delete xlApp
p_Excel_to_Dbf = dbf_file

END FUNCTION

Bill.

Bill Parker
11-22-2005, 03:57 PM
This version of the function changes the way that the ToCell parameter is calculated if it is passed in as blank. Previously the function did the equivalent of Ctl-End to find the ToCell. In some cases this can result in blank rows/columns in the output dbf file.

Now there are 2 options for finding ToCell. Default is to do a complete scan of the spreadsheet. This takes slightly longer, but is accurate. The other is "contiguous data", which means starting at the FromCell go to the first blank row and first blank column.

The previous method of finding ToCell is left in the code in case someone wants it, but it is commented out.

Enjoy.

Bill.

martinwcole
05-25-2006, 04:03 PM
Bill, using the last script you posted, I have the following results:

If I leave all parameters blank, and just call the function from interactive(V7-latest build), it works, but truncates the 2nd field/column after 65 characters.

Am including the xls file

Bill Parker
08-03-2006, 05:42 PM
Martin,

I just saw your message. There is a line in the code

xlApp.Selection.Columns.AutoFit() ' make all text visible. export only gets what is visible.

that expands the columns as needed for the export to include all data. It has always worked for me in the past. I did all sorts of tests with you file, and then changed the font in the spreadsheet from arial 10 to arial 12. After that the file converted correctly.

Don't ask me why. There is probably some explanation that I do not understand.

Bill.

Bill Parker
08-03-2006, 05:46 PM
Martin,

So I converted your spreadsheet back to the original format of arial 10 and the conversion to dbf still gets all the data correctly. There must have been something in the original spreadsheet that was causing the problem.

Bill.

martinwcole
08-03-2006, 06:28 PM
sounds pretty typical to me!!

"it works, but don't ask me why?"

Bill Parker
12-04-2007, 04:41 PM
Stan Mathews found a bug when the spreadsheet to import has more than 26 columns. Thanks Stan!

Bill.

Bill Parker
12-06-2007, 10:34 PM
I keep forgetting about the other embedded UDF in this function. p_DataPath() just gets the server path even if the database is shadowed. The version attached here removes that embedded UDF.

Bill.