Solved

How do I pass a variable to another process?

Posted on 2004-08-18
18
357 Views
Last Modified: 2008-03-03
Hi, Ok...I have a form in Access 2000.  

1) I use the following code to pick a directory for which all the .txt files should be imported into the Access database:

Option Compare Database

'***************** Code Start **************
'This code was originally written by Ken Getz.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
' Code courtesy of:
' Microsoft Access 95 How-To
' Ken Getz and Paul Litwin
' Waite Group Press, 1996

Type tagOPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    strFilter As String
    strCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    strFile As String
    nMaxFile As Long
    strFileTitle As String
    nMaxFileTitle As Long
    strInitialDir As String
    strTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    strDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
    Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
' You won't use these.
'Global Const ahtOFN_ENABLEHOOK = &H20
'Global Const ahtOFN_ENABLETEMPLATE = &H40
'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
' New for Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000


Function TestIt()
    Dim strFilter As String
    Dim lngFlags As Long
    strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", _
                    "*.MDA;*.MDB")
    strFilter = ahtAddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF")
    strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
    strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
    MsgBox "You selected: " & ahtCommonFileOpenSave(InitialDir:="C:\", _
        Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
        DialogTitle:="Hello! Open Me!")
    ' Since you passed in a variable for lngFlags,
    ' the function places the output flags value in the variable.
    Debug.Print Hex(lngFlags)
End Function

Function GetOpenFile(Optional varDirectory As Variant, _
    Optional varTitleForDialog As Variant) As Variant
' Here's an example that gets an Access database name.
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
' Specify that the chosen file must already exist,
' don't change directories when you're done
' Also, don't bother displaying
' the read-only box. It'll only confuse people.
    lngFlags = ahtOFN_FILEMUSTEXIST Or _
                ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
    If IsMissing(varDirectory) Then
        varDirectory = ""
    End If
    If IsMissing(varTitleForDialog) Then
        varTitleForDialog = ""
    End If

    ' Define the filter string and allocate space in the "c"
    ' string Duplicate this line with changes as necessary for
    ' more file templates.
        strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
   
    ' Now actually call to get the file name.
    varFileName = ahtCommonFileOpenSave( _
                    OpenFile:=True, _
                    InitialDir:=varDirectory, _
                    Filter:=strFilter, _
                    Flags:=lngFlags, _
                    DialogTitle:=varTitleForDialog)
    If Not IsNull(varFileName) Then
        varFileName = TrimNull(varFileName)
    End If
    GetOpenFile = varFileName

'**********ADDED CODE************

    'Not Sure if you actually need the If statement - it may work with just the DoCmd line
    'I'm only using the If stmnt to make sure there was a file path selected and the variable is Not Null
    'If the variable was Null then the DoCmd would produce Errors - not nice...

    If Not IsNull(varFileName) Then
        DoCmd.TransferText acImportFixed, "UCCL0885 Import Specification", "UCCL0885", GetOpenFile
    End If

'************END*****************

End Function


Function ahtCommonFileOpenSave( _
            Optional ByRef Flags As Variant, _
            Optional ByVal InitialDir As Variant, _
            Optional ByVal Filter As Variant, _
            Optional ByVal FilterIndex As Variant, _
            Optional ByVal DefaultExt As Variant, _
            Optional ByVal FileName As Variant, _
            Optional ByVal DialogTitle As Variant, _
            Optional ByVal hwnd As Variant, _
            Optional ByVal OpenFile As Variant) As Variant
' This is the entry point you'll use to call the common
' file open/save dialog. The parameters are listed
' below, and all are optional.
'
' In:
' Flags: one or more of the ahtOFN_* constants, OR'd together.
' InitialDir: the directory in which to first look
' Filter: a set of file filters, set up by calling
' AddFilterItem. See examples.
' FilterIndex: 1-based integer indicating which filter
' set to use, by default (1 if unspecified)
' DefaultExt: Extension to use if the user doesn't enter one.
' Only useful on file saves.
' FileName: Default value for the file name text box.
' DialogTitle: Title for the dialog.
' hWnd: parent window handle
' OpenFile: Boolean(True=Open File/False=Save As)
' Out:
' Return Value: Either Null or the selected filename
Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
    ' Give the dialog a caption title.
    If IsMissing(InitialDir) Then InitialDir = CurDir
    If IsMissing(Filter) Then Filter = ""
    If IsMissing(FilterIndex) Then FilterIndex = 1
    If IsMissing(Flags) Then Flags = 0&
    If IsMissing(DefaultExt) Then DefaultExt = ""
    If IsMissing(FileName) Then FileName = ""
    If IsMissing(DialogTitle) Then DialogTitle = ""
    If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
    If IsMissing(OpenFile) Then OpenFile = True
    ' Allocate string space for the returned strings.
    strFileName = Left(FileName & String(256, 0), 256)
    strFileTitle = String(256, 0)
    ' Set up the data structure before you call the function
    With OFN
        .lStructSize = Len(OFN)
        .hwndOwner = hwnd
        .strFilter = Filter
        .nFilterIndex = FilterIndex
        .strFile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = DialogTitle
        .Flags = Flags
        .strDefExt = DefaultExt
        .strInitialDir = InitialDir
        ' Didn't think most people would want to deal with
        ' these options.
        .hInstance = 0
        '.strCustomFilter = ""
        '.nMaxCustFilter = 0
        .lpfnHook = 0
        'New for NT 4.0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
    End With
    ' This will pass the desired data structure to the
    ' Windows API, which will in turn it uses to display
    ' the Open/Save As Dialog.
    If OpenFile Then
        fResult = aht_apiGetOpenFileName(OFN)
    Else
        fResult = aht_apiGetSaveFileName(OFN)
    End If

    ' The function call filled in the strFileTitle member
    ' of the structure. You'll have to write special code
    ' to retrieve that if you're interested.
    If fResult Then
        ' You might care to check the Flags member of the
        ' structure to get information about the chosen file.
        ' In this example, if you bothered to pass in a
        ' value for Flags, we'll fill it in with the outgoing
        ' Flags value.
        If Not IsMissing(Flags) Then Flags = OFN.Flags
        ahtCommonFileOpenSave = TrimNull(OFN.strFile)
    Else
        ahtCommonFileOpenSave = vbNullString
    End If
End Function

Function ahtAddFilterItem(strFilter As String, _
    strDescription As String, Optional varItem As Variant) As String
' Tack a new chunk onto the file filter.
' That is, take the old value, stick onto it the description,
' (like "Databases"), a null character, the skeleton
' (like "*.mdb;*.mda") and a final null character.

    If IsMissing(varItem) Then varItem = "*.*"
    ahtAddFilterItem = strFilter & _
                strDescription & vbNullChar & _
                varItem & vbNullChar
End Function

Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
        TrimNull = Left(strItem, intPos - 1)
    Else
        TrimNull = strItem
    End If
End Function
'************** Code End *****************

2) After I pick the directory, I have another function to import all these files.  The problem is I can't get this import function to recognize the directory I just picked in the previous step.  Can you guys take a look and let me know what I can do so that the import is pulling the files from the correct directory?

This is my import code:

Option Compare Database
Option Explicit

Sub bogus()

End Sub


'**************************************************************************
Public Function ShowSelectDir() As Boolean
    Dim frm As Form_SelectDir
   
    ' Show Selection form.
    Set frm = Form_SelectDir
    frm.SetFocus
End Function

'**************************************************************************
Public Function ImportText(szcurrentdir As String) As Boolean
    Dim szfile As String, szType As String
    Dim szSep As String
    Dim GetOpenFile As String    'Dim szcurrentdir As String,
    Dim szMacro As String
    Dim sFile As String
   
    ' this better be where you want to be
    'szcurrentdir = CurDir()
    MsgBox szcurrentdir
   
    'Application.DoCmd.OpenForm
   
    ' the path separator is always "\" in DOS/Windows
    szSep = "\"
   
    ' get the first file...note this call will fail if
    ' you are in a root...Les if you want to check the current directory
    ' to fix this bug be my guest
   
    szfile = Dir(szcurrentdir & szSep & "*.txt")
   
    'Set gfrmEDI = Form_frmSAEDI
    'gfrmEDI.SetFocus
   
    'DoCmd.TransferText acImportFixed, "USA Import Specification", "External Report", "Q:\SA\Text Import\09-21-00\Usa1201.txt"
    'Application.RunCommand (acCmdSaveAs)
   
    Do While szfile <> ""
   
    'concatenate the selected directory and the text file in question
    GetOpenFile = szcurrentdir & "\" & szfile
   
    If Len(szfile) > 11 Then
        szType = Left$(szfile, 4)
        szType = Right$(szType, 1)
        'concatenate the selected directory and the text file in question
        'GetOpenFile = szCurrentDir & "\" & szFile
       
        Select Case szType
            Case 5
                'MsgBox "UCCL0885"
                DoCmd.TransferText acImportFixed, "UCCL0885 Import Specification", "UCCL0885", GetOpenFile
            Case 6
                'MsgBox "UCCL0886"
                DoCmd.TransferText acImportFixed, "UCCL0886 Import Specification", "UCCL0886", GetOpenFile
            Case 7
                'MsgBox "UCCL0887"
                DoCmd.TransferText acImportFixed, "UCCL0887 Import Specification", "UCCL0887", GetOpenFile
            Case 8
                'MsgBox "UCCL0888"
                DoCmd.TransferText acImportFixed, "UCCLO888 Import Specification", "UCCL0888", GetOpenFile
            Case 9
                'MsgBox "UCCL0889"
                DoCmd.TransferText acImportFixed, "UCCLO889 Import Specification", "UCCL0889", GetOpenFile
            Case "u"
                'MsgBox "UCCL088u"
                DoCmd.TransferText acImportFixed, "UCCL088u Import Specification", "UCCL088u", GetOpenFile
            Case Else
                MsgBox "Unrecognized file type."
        End Select
    Else
        'MsgBox "UCCL088a"
        DoCmd.TransferText acImportFixed, "UCCL088 Import Specification", "UCCL088a", GetOpenFile
    End If
   
    ' get new file
    szfile = Dir()
   
    Loop
End Function


Sub FormatICD9()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    'MsgBox (Len(rs!Icd9_1))
    If Len(rs!Icd9_1) = 5 Then
        rs.Edit
        rs!Icd9_1 = Left$(rs!Icd9_1, 3) & "." & Right$(rs!Icd9_1, 2)
        rs.Update
    ElseIf Len(rs!Icd9_1) = 4 Then
        rs.Edit
        rs!Icd9_1 = Left$(rs!Icd9_1, 3) & "." & Right$(rs!Icd9_1, 1)
        rs.Update
    ElseIf Len(rs!Icd9_1) = 3 Then
        rs.Edit
        rs!Icd9_1 = rs!Icd9_1
        rs.Update
    Else
        rs.Edit
        rs!Icd9_1 = ""
        rs.Update
    End If
    rs.MoveNext
Loop

End Sub


Sub FormatICD9_2()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    'MsgBox (rs!Icd9_2)
    If Len(rs!Icd9_2) = 5 Then
        rs.Edit
        rs!Icd9_2 = Left$(rs!Icd9_2, 3) & "." & Right$(rs!Icd9_2, 2)
        rs.Update
    ElseIf Len(rs!Icd9_2) = 4 Then
        rs.Edit
        rs!Icd9_2 = Left$(rs!Icd9_2, 3) & "." & Right$(rs!Icd9_2, 1)
        rs.Update
    ElseIf Len(rs!Icd9_2) = 3 Then
        rs.Edit
        rs!Icd9_2 = rs!Icd9_2
        rs.Update
    Else
        rs.Edit
        rs!Icd9_2 = ""
        rs.Update
    'MsgBox (rs!Icd9_2)
    End If
    rs.MoveNext
Loop

End Sub


Sub FormatChargeAmt()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    'MsgBox (rs!ChargedAmt)
        rs.Edit
        rs!ChargedAmt = rs!ChargedAmt / 100
        rs.Update
        rs.MoveNext
Loop

End Sub

Sub FormatPaidAmt()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    'MsgBox (rs!ChargedAmt)
        rs.Edit
        rs!PaidAmt = rs!PaidAmt / 100
        rs.Update
        rs.MoveNext
Loop

End Sub

Sub FormatAllowedAmt()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    'MsgBox (rs!ChargedAmt)
        rs.Edit
        rs!AllowedAmt = rs!AllowedAmt / 100
        rs.Update
        rs.MoveNext
Loop

End Sub

Sub FormatDates()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF

        rs.Edit
        rs!begin = Mid$(rs!begin, 5, 2) & "/" & Right$(rs!begin, 2) & "/" & Left$(rs!begin, 4)
        rs!End = Mid$(rs!End, 5, 2) & "/" & Right$(rs!End, 2) & "/" & Left$(rs!End, 4)
        rs!PaidDate = Mid$(rs!PaidDate, 5, 2) & "/" & Right$(rs!PaidDate, 2) & "/" & Left$(rs!PaidDate, 4)
        rs.Update
        rs.MoveNext
Loop

End Sub

Sub AddPlaceholderDate()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF

        rs.Edit
        rs!BeginDate = Right$(rs!begin, 4) & "/" & Left$(rs!begin, 5)
        rs.Update
        rs.MoveNext
Loop

End Sub

Sub Capitation()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    If rs!Ex_Array = "CC" Then
        rs.Edit
        rs!PaidAmt = rs!AllowedAmt
        rs.Update
    End If
    rs.MoveNext
Loop

End Sub

0
Comment
Question by:Ingx_Sub
  • 9
  • 6
  • 3
18 Comments
 
LVL 84
Comment Utility
I don't see where you're calling the GetOpenFile dialog ... where is this occurring?
0
 
LVL 84
Comment Utility
What I meant was - are you calling GetOpenFile for EACh TransferText command? Is the file dialog being called before Step 2?
0
 

Author Comment

by:Ingx_Sub
Comment Utility
Good question.  Where would you expect to see that?  The whole code in Step 1 is what's used to pick the file.  

This is Access 2000 by the way.  And, if I remember correctly from past experiences I couldn't get the GetOpenFile dialog to work with Access 2000???
0
 

Author Comment

by:Ingx_Sub
Comment Utility
Hmm...I'm not sure how to answer that :(  I have this same stuff set up to work in Access 2002, and this is what step 1 looks like:

SELECT Count(SN.CASE_ID), Sum(sn.AMOUNT)
FROM SUBRO.SUBRO_CASE sc, SUBRO.SUBRO_NEGOTIATION SN, SUBRO.SUBRO_CASE_CLIENT sccl
WHERE sccl.CLIENT_ID > 76
and sccl.client_id not between 279 and 290
AND sn.NEGOTIATION_TYPE_ID=4
AND sc.CASE_STATUS_ID In (2,6)
AND sn.CASE_ID = sc.case_id
And sn.CASE_ID Not In (select case_id from subro.subro_payment where active_ind = 'Y')
AND sccl.CASE_ID = sn.case_id
and sn.entered_dt < '31-Jul-04'

Public Sub GetDir_Click()
    Dim sFile As String, sDir As String
    Dim result As Integer
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select File"
        .Filters.Add "All Files", "*.*"
        .FilterIndex = 3
        .AllowMultiSelect = False
        .InitialFileName = CurrentProject.Path
        result = .Show
        If (result <> 0) Then
            sFile = Trim(.SelectedItems.Item(1))
            sDir = Dir$(sFile, vbDirectory)
        End If
    End With
End Sub

So, that picked the directory, and then this is the import code...which I believe is the same as the code I'm trying to use in the Access 2000 version.

Step 2:

Option Compare Database
Option Explicit

Sub bogus()

End Sub


'**************************************************************************
Public Function ShowSelectDir() As Boolean
    Dim frm As Form_SelectDir
   
    ' Show Selection form.
    Set frm = Form_SelectDir
    frm.SetFocus
End Function

'**************************************************************************
Public Function ImportText() As Boolean
    Dim szFile As String, szType As String
    Dim szSep As String
    Dim szCurrentDir As String, szDir As String
    Dim szMacro As String
    Dim sFile As String
   
    ' this better be where you want to be
    szCurrentDir = CurDir()
    MsgBox szCurrentDir
   
    'Application.DoCmd.OpenForm
   
    ' the path separator is always "\" in DOS/Windows
    szSep = "\"
   
    ' get the first file...note this call will fail if
    ' you are in a root...Les if you want to check the current directory
    ' to fix this bug be my guest
    szFile = Dir(szCurrentDir & szSep & "*.txt")
   
    'Set gfrmEDI = Form_frmSAEDI
    'gfrmEDI.SetFocus
   
    'DoCmd.TransferText acImportFixed, "USA Import Specification", "External Report", "Q:\SA\Text Import\09-21-00\Usa1201.txt"
    'Application.RunCommand (acCmdSaveAs)
   
    Do While szFile <> ""
   
    'concatenate the selected directory and the text file in question
    szDir = szCurrentDir & "\" & szFile
   
    If Len(szFile) > 11 Then
        szType = Left$(szFile, 4)
        szType = Right$(szType, 1)
        'concatenate the selected directory and the text file in question
        'szDir = szCurrentDir & "\" & szFile
       
        Select Case szType
            Case 5
                'MsgBox "UCCL0885"
                DoCmd.TransferText acImportFixed, "UCCL0885 Import Specification", "UCCL0885", szDir
            Case 6
                'MsgBox "UCCL0886"
                DoCmd.TransferText acImportFixed, "UCCL0886 Import Specification", "UCCL0886", szDir
            Case 7
                'MsgBox "UCCL0887"
                DoCmd.TransferText acImportFixed, "UCCL0887 Import Specification", "UCCL0887", szDir
            Case 8
                'MsgBox "UCCL0888"
                DoCmd.TransferText acImportFixed, "UCCLO888 Import Specification", "UCCL0888", szDir
            Case 9
                'MsgBox "UCCL0889"
                DoCmd.TransferText acImportFixed, "UCCLO889 Import Specification", "UCCL0889", szDir
            Case "u"
                'MsgBox "UCCL088u"
                DoCmd.TransferText acImportFixed, "UCCL088u Import Specification", "UCCL088u", szDir
            Case Else
                MsgBox "Unrecognized file type."
        End Select
    Else
        'MsgBox "UCCL088a"
        DoCmd.TransferText acImportFixed, "UCCL088 Import Specification", "UCCL088a", szDir
    End If
   
    ' get new file
    szFile = Dir()
   
    Loop
End Function


Sub FormatICD9()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    'MsgBox (Len(rs!Icd9_1))
    If Len(rs!Icd9_1) = 5 Then
        rs.Edit
        rs!Icd9_1 = Left$(rs!Icd9_1, 3) & "." & Right$(rs!Icd9_1, 2)
        rs.Update
    ElseIf Len(rs!Icd9_1) = 4 Then
        rs.Edit
        rs!Icd9_1 = Left$(rs!Icd9_1, 3) & "." & Right$(rs!Icd9_1, 1)
        rs.Update
    ElseIf Len(rs!Icd9_1) = 3 Then
        rs.Edit
        rs!Icd9_1 = rs!Icd9_1
        rs.Update
    Else
        rs.Edit
        rs!Icd9_1 = ""
        rs.Update
    End If
    rs.MoveNext
Loop

End Sub


Sub FormatICD9_2()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    'MsgBox (rs!Icd9_2)
    If Len(rs!Icd9_2) = 5 Then
        rs.Edit
        rs!Icd9_2 = Left$(rs!Icd9_2, 3) & "." & Right$(rs!Icd9_2, 2)
        rs.Update
    ElseIf Len(rs!Icd9_2) = 4 Then
        rs.Edit
        rs!Icd9_2 = Left$(rs!Icd9_2, 3) & "." & Right$(rs!Icd9_2, 1)
        rs.Update
    ElseIf Len(rs!Icd9_2) = 3 Then
        rs.Edit
        rs!Icd9_2 = rs!Icd9_2
        rs.Update
    Else
        rs.Edit
        rs!Icd9_2 = ""
        rs.Update
    'MsgBox (rs!Icd9_2)
    End If
    rs.MoveNext
Loop

End Sub


Sub FormatChargeAmt()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    'MsgBox (rs!ChargedAmt)
        rs.Edit
        rs!ChargedAmt = rs!ChargedAmt / 100
        rs.Update
        rs.MoveNext
Loop

End Sub

Sub FormatPaidAmt()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    'MsgBox (rs!ChargedAmt)
        rs.Edit
        rs!PaidAmt = rs!PaidAmt / 100
        rs.Update
        rs.MoveNext
Loop

End Sub

Sub FormatAllowedAmt()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    'MsgBox (rs!ChargedAmt)
        rs.Edit
        rs!AllowedAmt = rs!AllowedAmt / 100
        rs.Update
        rs.MoveNext
Loop

End Sub

Sub FormatDates()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF

        rs.Edit
        rs!begin = Mid$(rs!begin, 5, 2) & "/" & Right$(rs!begin, 2) & "/" & Left$(rs!begin, 4)
        rs!End = Mid$(rs!End, 5, 2) & "/" & Right$(rs!End, 2) & "/" & Left$(rs!End, 4)
        rs!PaidDate = Mid$(rs!PaidDate, 5, 2) & "/" & Right$(rs!PaidDate, 2) & "/" & Left$(rs!PaidDate, 4)
        rs.Update
        rs.MoveNext
Loop

End Sub

Sub AddPlaceholderDate()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF

        rs.Edit
        rs!BeginDate = Right$(rs!begin, 4) & "/" & Left$(rs!begin, 5)
        rs.Update
        rs.MoveNext
Loop

End Sub

Sub Capitation()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    If rs!Ex_Array = "CC" Then
        rs.Edit
        rs!PaidAmt = rs!AllowedAmt
        rs.Update
    End If
    rs.MoveNext
Loop

End Sub
0
 
LVL 34

Expert Comment

by:flavo
Comment Utility
I use this code to grab a directory.  Nice and tidy

Called by

Dim sPath as string

sPath = BrowseFolder("c:\myDir\")

Dave!

Option Compare Database
Option Explicit

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
           "SHBrowseForFolderA" (lpBrowseInfo As BrowseForFolderInfo _
                                ) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
           "SHGetPathFromIDListA" (ByVal pidl As Long, _
                                   ByVal pszPath As String _
                                  ) As Long
Private Type BrowseForFolderInfo
 hOwner         As Long
 pidlRoot       As Long
 pszDisplayName As String
 lpszTitle      As String
 ulFlags        As Long
 lpfn           As Long
 lParam         As Long
 iImage         As Long
End Type

Public Function BrowseFolder(szDialogTitle As String) As String
 
' Interface:       <path> = BrowseFolder(<title for dialog>)
'                  The 'title' above is NOT the window-frame title,
'                  but is a prompt in the client area of the dlg.
' Return:          Path without a trailing \.
   
   Dim bi As BrowseForFolderInfo
   Dim dwIList As Long
   Dim szPath As String
 
   With bi
       .hOwner = hWndAccessApp
       .lpszTitle = szDialogTitle
   End With
   
   dwIList = SHBrowseForFolder(bi) ' Present the dlg.
                                   ' Returns the ID of the folder selected.
   szPath = Space$(512)
   
   ' SHGetPathFromIDList Puts a string to the ID returned by SHBrowseForFolder
   If SHGetPathFromIDList(ByVal dwIList, ByVal szPath) Then
       BrowseFolder = Left$(szPath, InStr(szPath, Chr(0)) - 1)
   Else
       BrowseFolder = ""
   End If
End Function
0
 
LVL 84

Accepted Solution

by:
Scott McDaniel (Microsoft Access MVP - EE MVE ) earned 350 total points
Comment Utility
The code in Step 1 is a combination of several things ... genearlly speaking, this code is called via a Button click:

Sub btnOpenFile_Click()

Dim strName As String

strName = GetOpenFile()

End Sub

After running this, the strName variable would hold the value selected by the User (if any). I use this code in all my applications (and most of them are written in Access 2000) and it works fiine. I'd suspect you'd want to call this in the beginning of your ImportText function:

Public Function ImportText(szcurrentdir As String) As Boolean
    Dim szfile As String, szType As String
    Dim szSep As String
    '/really shouldn't name a variable the same thing as a public function - just asking for trouble
    '/Dim GetOpenFile As String    'Dim szcurrentdir As String,
    Dim szMacro As String
    Dim sFile As String
    Dim strPath As String
   
  strPath = GetOpenFile()

  <your other code here>

At this point, strPath would contain the value selected by the user. You could use this in any area of the SAME function to determine where to send files.

0
 

Author Comment

by:Ingx_Sub
Comment Utility
Ok LMConsulting...just so I get this right...Would I add this:

Public Function ImportText(szcurrentdir As String) As Boolean
    Dim szfile As String, szType As String
    Dim szSep As String
    '/really shouldn't name a variable the same thing as a public function - just asking for trouble
    '/Dim GetOpenFile As String    'Dim szcurrentdir As String,
    Dim szMacro As String
    Dim sFile As String
    Dim strPath As String
   
  strPath = GetOpenFile()
 
In the spot where this currently is:

**************************************************************************
Public Function ShowSelectDir() As Boolean
    Dim frm As Form_SelectDir
   
    ' Show Selection form.
    Set frm = Form_SelectDir
    frm.SetFocus
End Function

'**************************************************************************
Public Function ImportText(szcurrentdir As String) As Boolean
    Dim szfile As String, szType As String
    Dim szSep As String
    Dim GetOpenFile As String    'Dim szcurrentdir As String,
    Dim szMacro As String
    Dim sFile As String
   
    ' this better be where you want to be
    'szcurrentdir = CurDir()
    MsgBox szcurrentdir


??????

0
 

Author Comment

by:Ingx_Sub
Comment Utility
Ok, this is the code on my form:

Option Compare Database
Option Explicit

Private Sub cmdExit_Click()
    Form_SelectDir.Visible = False
End Sub

Private Sub cmdImport_Click()
    ImportText
    MsgBox "Text files have been imported."
End Sub

Private Sub GetDir_Click()
   Dim szdirectory As String
   szdirectory = GetOpenFile
    'Me!Text5 = szdirectory
End Sub

LMConsulting, I made that change you suggested, so the top of my import spec looks like this now:

ption Compare Database
Option Explicit

Sub bogus()

End Sub


'**************************************************************************
Public Function ShowSelectDir() As Boolean
    Dim frm As Form_SelectDir
   
    ' Show Selection form.
    Set frm = Form_SelectDir
    frm.SetFocus
End Function

'**************************************************************************
Public Function ImportText(szcurrentdir As String) As Boolean
    Dim szfile As String, szType As String
    Dim szSep As String
    '/really shouldn't name a variable the same thing as a public function - just asking for trouble
    '/Dim GetOpenFile As String    'Dim szcurrentdir As String,
    Dim szMacro As String
    Dim sFile As String
    Dim strPath As String
   
  strPath = GetOpenFile()
   
    ' this better be where you want to be
    'szcurrentdir = CurDir()
    MsgBox szcurrentdir
   
    'Application.DoCmd.OpenForm
   
    ' the path separator is always "\" in DOS/Windows
    szSep = "\"

Did I do that correctly?  Now when I click the "Import Text" button on my form, which is supposed to run this:

Private Sub cmdImport_Click()
    ImportText
    MsgBox "Text files have been imported."
End Sub

I get an error that says "Argument Not Optional" and highlights "ImportText".

Why is that?
0
 
LVL 34

Assisted Solution

by:flavo
flavo earned 150 total points
Comment Utility
You need to pass the directory name

use

 ImportText szdirectory
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 
LVL 34

Expert Comment

by:flavo
Comment Utility
this would be better

Private Sub cmdImport_Click()
Dim blDone as Boolean
      blDone =  ImportText(szdirectory)
  If blDone then
    MsgBox "Text files have been imported."
  else
    Msgboox "Error!"
  end if
End Sub
0
 

Author Comment

by:Ingx_Sub
Comment Utility
Ok I did that Flavo, and now I get a "Variable Not Defined" on szdirectory
0
 
LVL 84
Comment Utility
You have to set the value of "szDirector" to something:

Private Sub cmdImport_Click()
Dim blDone as Boolean

      blDone =  ImportText(CurrentProject.Path)

  If blDone then
    MsgBox "Text files have been imported."
  else
    Msgboox "Error!"
  end if
End Sub
0
 

Author Comment

by:Ingx_Sub
Comment Utility
Allright, now with that code change, I get the file picker window when I click the Import button on my form.  So I go ahead and choose my directory, then when I click the "Open" button on the File Picker window I get a pop up message to verify the location that I'm going to import from...but the location is not what I picked with the file picker.

It's like for some reason the directory I pick with the file picker isn't being passed to the import process.
0
 
LVL 84
Comment Utility
Repost the current code you have in the ImportText() function ... there's so much here now I'm getting confused as to which codebase we're talking about.
0
 

Author Comment

by:Ingx_Sub
Comment Utility
LOL...ok.

The import text function:

Private Sub cmdImport_Click()
Dim blDone as Boolean

      blDone =  ImportText(CurrentProject.Path)

  If blDone then
    MsgBox "Text files have been imported."
  else
    Msgboox "Error!"
  end if
End Sub
0
 
LVL 84
Comment Utility
Actually, I need to see the code contained in the ImportText() function ...
0
 

Author Comment

by:Ingx_Sub
Comment Utility
OH;

here:

Private Sub cmdImport_Click()
Dim blDone as Boolean

      blDone =  ImportText(CurrentProject.Path)

  If blDone then
    MsgBox "Text files have been imported."
  else
    Msgboox "Error!"
  end if
End Sub
0
 

Author Comment

by:Ingx_Sub
Comment Utility
Hey, I finally got it to work!!

THe form code is this:

Option Compare Database
Option Explicit

Private Sub cmdExit_Click()
    Form_SelectDir.Visible = False
End Sub

Private Sub cmdImport_Click()
    ImportText (Me!Text5)
    MsgBox "Text files have been imported."
End Sub




Private Sub GetDir_Click()
   Dim szdirectory As String
   szdirectory = GetOpenFile
    Me!Text5 = szdirectory
    MsgBox (szdirectory)
End Sub

The Import code is this:

'Public Function ImportText(szcurrentdir As String) As Boolean
 '   Dim szfile As String, szType As String
  '  Dim szSep As String
   ' Dim GetOpenFile As String    'Dim szcurrentdir As String,
    'Dim szMacro As String
    'Dim sFile As String
   
    ' this better be where you want to be
    'szcurrentdir = CurDir()
    'MsgBox szcurrentdir
   
    'Application.DoCmd.OpenForm
   
    ' the path separator is always "\" in DOS/Windows
    szSep = "\"
   
    ' get the first file...note this call will fail if
    ' you are in a root...Les if you want to check the current directory
    ' to fix this bug be my guest
    szfile = Dir(szcurrentdir & "*.txt")
    szdir = szcurrentdir & szfile
    'szfile = szcurrentdir & "*.txt"
   
    'Set gfrmEDI = Form_frmSAEDI
    'gfrmEDI.SetFocus
   
    'DoCmd.TransferText acImportFixed, "USA Import Specification", "External Report", "Q:\SA\Text Import\09-21-00\Usa1201.txt"
    'Application.RunCommand (acCmdSaveAs)
   
    Do While szfile <> ""
    'MsgBox (szfile)
    'concatenate the selected directory and the text file in question
    'GetOpenFile = szcurrentdir & szfile
   
    If Len(szfile) > 11 Then
        szType = Left$(szfile, 4)
        szType = Right$(szType, 1)
        'concatenate the selected directory and the text file in question
        'GetOpenFile = szCurrentDir & "\" & szFile
        szdir = szcurrentdir & szfile
        Select Case szType
            Case 5
                'MsgBox "UCCL0885"
                DoCmd.TransferText acImportFixed, "UCCL0885 Import Specification", "UCCL0885", szdir
            Case 6
                'MsgBox "UCCL0886"
                DoCmd.TransferText acImportFixed, "UCCL0886 Import Specification", "UCCL0886", szdir
            Case 7
                'MsgBox "UCCL0887"
                DoCmd.TransferText acImportFixed, "UCCL0887 Import Specification", "UCCL0887", szdir
            Case 8
                'MsgBox "UCCL0888"
                DoCmd.TransferText acImportFixed, "UCCLO888 Import Specification", "UCCL0888", szdir
            Case 9
                'MsgBox "UCCL0889"
                DoCmd.TransferText acImportFixed, "UCCLO889 Import Specification", "UCCL0889", szdir
            Case "u"
                'MsgBox "UCCL088u"
                DoCmd.TransferText acImportFixed, "UCCL088u Import Specification", "UCCL088u", szdir
            Case Else
                MsgBox "Unrecognized file type."
        End Select
    Else
        'MsgBox "UCCL088a"
        DoCmd.TransferText acImportFixed, "UCCL088 Import Specification", "UCCL088a", szdir
    End If
   
    ' get new file
    szfile = Dir()
   
    Loop
End Function


Sub FormatICD9()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    'MsgBox (Len(rs!Icd9_1))
    If Len(rs!Icd9_1) = 5 Then
        rs.Edit
        rs!Icd9_1 = Left$(rs!Icd9_1, 3) & "." & Right$(rs!Icd9_1, 2)
        rs.Update
    ElseIf Len(rs!Icd9_1) = 4 Then
        rs.Edit
        rs!Icd9_1 = Left$(rs!Icd9_1, 3) & "." & Right$(rs!Icd9_1, 1)
        rs.Update
    ElseIf Len(rs!Icd9_1) = 3 Then
        rs.Edit
        rs!Icd9_1 = rs!Icd9_1
        rs.Update
    Else
        rs.Edit
        rs!Icd9_1 = ""
        rs.Update
    End If
    rs.MoveNext
Loop

End Sub


Sub FormatICD9_2()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    'MsgBox (rs!Icd9_2)
    If Len(rs!Icd9_2) = 5 Then
        rs.Edit
        rs!Icd9_2 = Left$(rs!Icd9_2, 3) & "." & Right$(rs!Icd9_2, 2)
        rs.Update
    ElseIf Len(rs!Icd9_2) = 4 Then
        rs.Edit
        rs!Icd9_2 = Left$(rs!Icd9_2, 3) & "." & Right$(rs!Icd9_2, 1)
        rs.Update
    ElseIf Len(rs!Icd9_2) = 3 Then
        rs.Edit
        rs!Icd9_2 = rs!Icd9_2
        rs.Update
    Else
        rs.Edit
        rs!Icd9_2 = ""
        rs.Update
    'MsgBox (rs!Icd9_2)
    End If
    rs.MoveNext
Loop

End Sub


Sub FormatChargeAmt()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    'MsgBox (rs!ChargedAmt)
        rs.Edit
        rs!ChargedAmt = rs!ChargedAmt / 100
        rs.Update
        rs.MoveNext
Loop

End Sub

Sub FormatPaidAmt()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    'MsgBox (rs!ChargedAmt)
        rs.Edit
        rs!PaidAmt = rs!PaidAmt / 100
        rs.Update
        rs.MoveNext
Loop

End Sub

Sub FormatAllowedAmt()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    'MsgBox (rs!ChargedAmt)
        rs.Edit
        rs!AllowedAmt = rs!AllowedAmt / 100
        rs.Update
        rs.MoveNext
Loop

End Sub

Sub FormatDates()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF

        rs.Edit
        rs!begin = Mid$(rs!begin, 5, 2) & "/" & Right$(rs!begin, 2) & "/" & Left$(rs!begin, 4)
        rs!End = Mid$(rs!End, 5, 2) & "/" & Right$(rs!End, 2) & "/" & Left$(rs!End, 4)
        rs!PaidDate = Mid$(rs!PaidDate, 5, 2) & "/" & Right$(rs!PaidDate, 2) & "/" & Left$(rs!PaidDate, 4)
        rs.Update
        rs.MoveNext
Loop

End Sub

Sub AddPlaceholderDate()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF

        rs.Edit
        rs!BeginDate = Right$(rs!begin, 4) & "/" & Left$(rs!begin, 5)
        rs.Update
        rs.MoveNext
Loop

End Sub

Sub Capitation()

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("UCCL088a")

MsgBox ("are you sure you want to procede?")

Do Until rs.EOF
    If rs!Ex_Array = "CC" Then
        rs.Edit
        rs!PaidAmt = rs!AllowedAmt
        rs.Update
    End If
    rs.MoveNext
Loop

End Sub

Thanks for the help guys!!!
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

When you are entering numbers in a speadsheet, and don't remember what 6×7 is, you just type “=6*7" instead. It works in every cell! This is not so in Access. To enter the elusive 42 in a text box, you have to find a calculator, and then copy the re…
Introduction When developing Access applications, often we need to know whether an object exists.  This article presents a quick and reliable routine to determine if an object exists without that object being opened. If you wanted to inspect/ite…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Familiarize people with the process of utilizing SQL Server stored procedures from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Micr…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

7 Experts available now in Live!

Get 1:1 Help Now