error trapping / if statement

[jonnj]

Hi everyone.

In the code below, I am importing dbf files from DB4.
I recorded a macro and have made adjustments that I need so far.

I created a inputbox variable spath, which pulls the file from a db4 folder with two subfolders. i.e ( c:\db4\port\111111.

The spath inputbox gets the dbf from the subfolder with 6 digits in this case the "111111". This subfolder has many folders with the 6 digits. When a correct subfolder number is entered, the file is imported. When an incorrect number is entered into the input box, I get a MS JET OLE DB INITIALIATION INFORMATION ERROR, which I want to avoid.

What I am looking for is an if statement that sees that the folder number is not listed and gives a msgbox error and ends the sub. I have had trouble tying in the variable to do so...

for example, if the variable ds= 426950 and the if statement

If spath <> ds Then
MsgBox "Assignment Number not Found"
Exit Sub
End If
.

....work fine because 425950 is a listed number. I cannot leave the ds=426950 in the code. I need something that will replace that and know that number entered into the spath is correct or incorrect.

thank you in advance for any help you can give me on this problem.





Private Sub CommandButton2_Click()
'
' ImportName Macro
' Macro recorded 5/9/2006 by laxlunn
'
'
Dim spath As String
Dim ds As Double
ds = 426950


spath = InputBox("Enter Assignment Number", "Import Address", "")


If spath <> ds Then
MsgBox "Assignment Number not Found"
Exit Sub
End If

If Not IsNull(Range("Aa1001:bh1002")) Then
Range("Aa1001:bh1002").Select
Selection.ClearContents
Range("a1").Select

Else
If spath = vbNullString Then
Range("Aa1001:bh1002").Select
Selection.ClearContents
Range("a1").Select
Exit Sub
End If
End If



With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\db4\PORT\" & spath & ";Mode=Share Deny Write;Extended Proper" _
, _
"ties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Engine Type=18;Jet OLED" _
, _
"Batabase Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Passwo" _
, _
"rd="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDBon't Copy Locale on Compact=False;Jet O" _
, "LEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination _
:=Range("aa1001"))
.CommandType = xlCmdTable
.CommandText = Array("F_hist")
.Name = "F_hist"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
'.SourceDataFile = "C:\db4\PORT\426950\F_HIST
.Refresh BackgroundQuery:=False
End With
End Sub




John

 

[Loomah]

Hi
I've not much (any recently) experience of this type of thing but I'd suggest having a look at the Dir function or if you're using VBA6 (xl2k and above) have a look at the FileSystemObject object. From one or both of these you should be able to find out if a folder exists.

From (my v.poor) memory I think the FSO obj has a GetFolder (or GetDirectory) method but I'm living in the dark ages here and can't easily double check that for you. From this you should be able to trap the error.

Alternatively you could try to trap the error you're getting at the moment (though I think having better control by checking for the existence of the folder is much better practice). Assuming the error you're getting is trappable!

eg
Sub yoursub
on error goto handler
'your code here
exit sub
handler:
if err.description = "MS JET OLE DB INITIALIATION INFORMATION" then
exit sub
else
msgbox err.description
end if
end sub

Oh, btw, this thread would probably have been better placed in the VBA forum?

;-)

If a man says something and there are no women there to hear him, is he still wrong?
How do I get the best answers?​

 

[jonnj]

Hi Loomah,

Thx for replying, I will take your advice on both counts if your code does not work .

John