Public function createdbf (Strname As String, _
Strfolder as string, _
Optional Pfields as ifields AS ITABLE
'CreatedBF: Simple Function to Create A DBase File.
'NOTE: The name of the dbase file shop not contact the .dbf extension
'Email to me: cnwanyx@163.com
ON Error Goto EH
'Open the workspace
DIM PFWS as ifnessWorkspace
DIM PWORKSPACEFAACTORY As IWorkspaceFactory
DIM FS as Object
DIM Pfieldsedit as ifieldsedit
Dim pfieldedit as ifieldedit
DIM Pfield as ifield
Set PWorkspaceFactory = New ShapeFileWorkspaceFactory
Set fs = creteObject ("scripting.filesystemobject")
IF not fs.folderexists (strfolder) THEN
MsgBox "Folder Does NOT:" & VBCR & STRFOLDER
EXIT FUNCTION
END IF
Set pfws = pworkspacefactory.openfromfile (Strfolder, 0)
'IF A Fields Collection Is Not Passed in Ten Create ONE
IF pfields is nothing then
'Create the Fields Used by Our Object
Set Pfields = New Fields
Set pfieldsedit = pfields
PfieldSedit.fieldcount = 1
'Create Text Field
Set Pfield = New Field
Set pfieldedit = pfield
With pfieldedit
.Length = 30
.Name = "textfield"
.Type = esrifieldtypeString
End with
Set pfieldsedit.field (0) = pfield
END IF
SET CREATEDBF = Pfws.createTable (Strname, Pfields, Nothing, Nothing, "")
EXIT FUNCTION
EH:
MsgBox Err.Description, Vbinformation, "CreatedBF"
END FUNCTION
Use Note:
