Open all dbf files in a folder and save them as excel in another folder - vba

Question

I have a folder "test" containing several dbf files. I would like vba to open them in excel file and save them (in excel format) in another folder keeping the same dbf file names.
I found this code on the net and am trying to use this code for my needs but it won't work. Error message:
"sub of function not defined"
...please look into it.
Sub test()
Dim YourDirectory As String
Dim YourFileType As String
Dim LoadDirFileList As Variant
Dim ActiveFile As String
Dim FileCounter As Integer
Dim NewWb As Workbook
YourDirectory = "c:\Users\navin\Desktop\test\"
YourFileType = "dbf"
LoadDirFileList = GetFileList(YourDirectory)
If IsArray(LoadDirFileList) = False Then
MsgBox "No files found"
Exit Sub
Else
' Loop around each file in your directory
For FileCounter = LBound(LoadDirFileList) To UBound(LoadDirFileList)
ActiveFile = LoadDirFileList(FileCounter)
Debug.Print ActiveFile
If Right(ActiveFile, 3) = YourFileType Then
Set NewWb = Application.Workbooks.Open(YourDirectory & ActiveFile)
Call YourMacro(NewWb)
NewWb.SaveAs YourDirectory & Left(ActiveFile, Len(ActiveFile) - 4) & ".xlsx"
NewWb.Saved = True
NewWb.Close
Set NewWb = Nothing
End If
Next FileCounter
End If
End Sub

Answer 1

You missing the functions GetFileList and YourMacro. A quick search brought me to this website (I think you copied it from there). http://www.ozgrid.com/forum/printthread.php?t=56393
There are the missing functions. Copy those two also in your modul to make it run (I tested it with pdf-Files):
Function GetFileList(FileSpec As String) As Variant
' Author : Carl Mackinder (From JWalk)
' Last Update : 25/05/06
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
On Error GoTo NoFilesFound
FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound
' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
NoFilesFound:
GetFileList = False
End Function
Sub YourMacro(Wb As Workbook)
Dim ws As Worksheet
Set ws = Wb.Worksheets(1)
ws.Range("A6").Value = "=((+A2*$CN2)+(A3*$CN3)+(A4*$CN4)+(A5*$CN5))/SUM($CN2:$CN5)"
ws.Range("A6").Copy ws.Range("B6:CM6")
ws.Range("CO6").Value = "=CO2"
End Sub
To save files in a different directory:
Dim SaveDirectory As String
SaveDirectory = "c:\Users\navin\Desktop\test\converted to excel"
Replace this line
NewWb.SaveAs YourDirectory & Left(ActiveFile, Len(ActiveFile) - 4) & ".xlsx"
with this
NewWb.SaveAs SaveDirectory & Left(ActiveFile, Len(ActiveFile) - 4) & ".xlsx"