CurDir function: what it returns?

[mikevh]

Hi --

I'm new to writing Access VB code. I'm trying to use the
CurDir function to get the full path of the directory my
database is in. The full path is definitely

"D:\work\Chase Sample\payment"

However, when I call CurDir, it returns the PARENT of the
current directory, "D:\work\Chase Sample", leaving off the
final "payment" part.

Anyone know why it would do this? Any help much appreciated.

 

[zevw]

I would try!!

Dir(MyPath, vbDirectory)

Not CurrDir

 

[mikevh]

I don't understand, ZevW. I'm trying to GET the full path
of the directory my database is in. If I call the Dir
function, don't I need to SUPPLY a path as an argument?

 

[zevw]

Well!!

CurDir is not where your DB is located its where the Path of you computer is set to:

I"m copying you the way it is described in Microsoft Help.

==========================================
This example uses the CurDir function to return the current path.

' In Microsoft Windows:
' Assume current path on C drive is "C:\WINDOWS\SYSTEM".
' Assume current path on D drive is "D:\EXCEL".
' Assume C is the current drive.
==========================================

Why are you trying to get where your DB is, you know that, and no one should be able to move you DB around.

If you want to find out if a certain file exists they you use the Dir Command

This example uses the Dir function to check if certain files and directories exist.

Dim MyFile

' In Microsoft Windows:
' Returns "WIN.INI" if it exists.
MyFile = Dir("C:\WINDOWS\WIN.INI&quot

So please explain to me what is your goal, but CurDir is not going to do that.

 

[mikevh]

Why do I want to get the path when I already know where it
is? Good question. The code is still in the development
stage and may end up somewhere else. I want to extract the
current path so I can use it as part of a prompt in an
input box when I ask the user for the name of a file to
import.

I'm just very surprised that CurDir would lop off the name
of the current directory and only show the parent, since
from what I read in the help it looks like it should do
just what I wanted.

Here's the code. As I say, I'm new at VB, and learning as
I go along ... I appreciate any comments or suggestions.

Sub Payment_Out()
'Put out the "new" payment sample
'Mike 6/02

On Error GoTo ErrHandle

Dim Testing As Boolean
Testing = True

Dim mbTitle As String
mbTitle = "Payment Sample"

Dim ExportSpecName As String
ExportSpecName = "vbtestout Export Specification"

Dim importFileName As String
Dim exportFileName As String

Dim inTableName As String
Dim outTableName As String
Dim mbRetcode As Integer
Dim strSQL As String

Dim db As Database
Dim rs As Recordset
Dim outRecordCount As Long

Dim ThisDir As Variant
ThisDir = CurDir

'This msgbox shows "D:\work\Chase Sample\", instead of
'"D:\work\Chase Sample\payment"???
If Testing Then
mbRetcode = MsgBox("Current directory: " & ThisDir, _
vbInformation + vbOKOnly)
End If

Set db = CurrentDb

GetImportName:
'Get name of file to import
'(At this writing [6/02] this is always an Excel file.)

importFileName = InputBox("Name of file to import", _
mbTitle, CurDir & "\" & "*.xls&quot
If importFileName = "" Then
GoTo Done
End If

inTableName = InputBox("Table to import into", mbTitle)
If inTableName = "" Then
GoTo Done
End If

'Delete the table if it already exists
'Note we must include err handling below for cases
'where table DOESN'T exist

strSQL = "DROP TABLE " & inTableName
DoCmd.RunSQL (strSQL)

'Do the import
DoCmd.TransferSpreadsheet acImport, , _
inTableName, importFileName, True

'Get output table name
outTableName = InputBox("Name of Output Table", mbTitle)
If outTableName = "" Then
GoTo Done
End If

'Delete the table if it already exists
'Note we must include err handling below for cases
'where table DOESN'T exist

strSQL = "DROP TABLE " & outTableName
DoCmd.RunSQL (strSQL)

'Create the output table
strSQL = "CREATE TABLE " & outTableName & _
" ( phonenum TEXT(21), " & _
"[CFMC SPECIAL] TEXT(1)," & _
"[CFMC TZ] TEXT(2)," & _
"[CFMC GET CASE] TEXT(6)," & _
"[CFMC CB] TEXT(16)," & _
"[CFMC REP] TEXT(4)," & _
"EAcct Text(16)," & _
"ChName Text(107)," & _
"Hphone Text(10)," & _
"DatInt Text(10)," & _
"DatAct Text(10)," & _
"Bucket Text(133)," & _
"SlType Text(2)," & _
"CDN Text(2)," & _
"SlQues Text(3)," & _
"SlMkt Text(2)" & _
""

'Debug.Print strSQL
'Debug.Print
DoCmd.RunSQL (strSQL)

'Populate the output table with sample reformatted
'the way we want it.

strSQL = "INSERT INTO " & outTableName & _
" SELECT mid([Phone Number],2,3) &" & _
" mid([Phone Number],7,3) &" & _
" mid([Phone Number],11,4) AS Phonenum," & _
" mid([Account Number],1,4) &" & _
" mid([Account Number],6,4) &" & _
" mid([Account Number],11,4) &" & _
" mid([Account Number],16,4) AS EAcct," & _
" ucase([Customer's first name]) & ' ' &" & _
" ucase([Customer's Last Name]) AS ChName," & _
" mid([Phone Number],2,3) &" & _
" mid([Phone Number],7,3) &" & _
" mid([Phone Number],11,4) AS Hphone," & _
" format(Month([Date/Time Received]),'00') & '/' &" & _
" format(Day([Date/Time Received]),'00') & '/' &" & _
" Year([Date/Time Received]) AS DatInt," & _
" format(Month([Date/Time Completed]),'00') & '/' &" & _
" format(Day([Date/Time Completed]),'00') & '/' &" & _
" Year([Date/Time Completed]) AS DatAct, 'PY' AS Bucket," & _
" '9' AS SlType," & _
" '99' AS CDN," & _
" '07' AS SlQues," & _
" '99' AS SlMkt" & _
" FROM " & inTableName & ";"

'Debug.Print strSQL
DoCmd.RunSQL (strSQL)

'Get name of file to export
'This is a fixed-length text file

exportFileName = InputBox("Name of file to export", _
mbTitle, CurDir & "\" & "*.txt&quot
If exportFileName = "" Then
GoTo Done
End If

'Do the export
DoCmd.TransferText acExportFixed, ExportSpecName, _
outTableName, exportFileName

'Get number of records in outTableName for reporting
'purposes.
'Of course, this assumes that all records got exported
Set rs = db.OpenRecordset(outTableName)
rs.MoveLast
outRecordCount = rs.RecordCount

rs.Close
db.Close

mbRetcode = MsgBox(outRecordCount & _
" records exported to " & vbCrLf & _
exportFileName, vbOKOnly, mbTitle)

Done:

Set rs = Nothing
Set db = Nothing
Exit Sub

ErrHandle:
If Err.Number = 3376 Then
'Table doesn 't exist, caused by drop table, ignore
Debug.Print Err.Number & ": " & Err.Description & vbCrLf
Resume Next
Else
mbRetcode = MsgBox("Error " & Err.Number & vbCrLf & _
Err.Description, vbCritical + vbOKOnly, "Error&quot

If Err.Number = 3011 Then
'cant find import file - reprompt
Debug.Print Err.Number & ": " & Err.Description & vbCrLf
Resume GetImportName
End If
End If

'Any other errors, cleanup and exit
Resume Done

End Sub

 

[zevw]

I"m sorry I did not go through all your code!!

but whatever happens to the DB - where ever you the programmer puts it , that is the place it should stay:

now when a user wants to import or export info he should specify where the excel file is located and import it into your database.

Bill Gates asks every user when they want to import a file into Access, where the file is located and it is understood that it goes into the current DB.

Same goes for exporting, when a user wants to export, Access asks the user where do you want to export that file and it is understood that its from the current DB.

However I looked just now and found a function "SysCmd" it sounds like it my be doing what you want.

Check it out.

 

[mikevh]

Thanks, zevw. I took a look at SysCmd. It does look
interesting, but not quite what I needed.

I did solve my problem, however. I found an article on
the Microsoft Knowledge Base on "How to Determine the
Name and Path of the Current Database" at the following
address:

http://support.microsoft.com/default.aspx?scid=kb;en-us;Q113919

Basically it points out that the full pathname of a
Database object is contained in that object's Name property.
So once I had that, all I had to do was write a function
to extract everything up to the last "\". Here's the
relevant code:

Sub Payment_Out()
Set db = CurrentDb

Dim ThisDir As String
ThisDir = GetDir(db.Name)

Dim importFileName as String

'Get name of file to import

importFileName = InputBox("Name of file to import", _
mbTitle, ThisDir & "*.xls&quot

'blah, blah, blah ...
End Sub

Function GetDir(ByVal FullPath As String) As String
'Takes a full pathname as argument, returns everything up to and including last "\".

Dim Start As Integer
Dim pos As Integer

Start = 1
GetDir = ""
Do
pos = InStr(Start, FullPath, "\&quot
If pos > 0 Then
GetDir = GetDir & _
Mid(FullPath, Start, pos - Start + 1)
Start = pos + 1
End If
Loop While pos > 0
End Function

Works like a charm!

 

[BigTeeJay]

Another easy way to get the current apps' path...

appPath = CurrentProject.Path

...I find it useful to include a pub function
that retrieves this and sets it to a global var.

Hope you find this useful.

Tj