Results 1 to 3 of 3
  1. #1
    Join Date
    Nov 2009
    Posts
    2

    New guy with a question.

    Hello, my name is Murdock and I recently joined this forum. I am here to gain more knowledge as well as share my knowledge. I am currently employed as a Analyst for an health care organization and I use Ms Access on daily basis.

    I have a project at my job to update an existing Access Switch Board that a department has been using to generate reports. A developer had initially design the Switch Board, but the organization is no longer in contact with the developer, and now the Switch Board has been malfunctioning.

    The problem at hand is the tables and the Switch Board were developed and saved in a Novell share drive, the company recently migrated from Novell over to a Windows share drive. I believe the Switchboard is probably malfunctioning, because it's now in a new directory, and the scripting still has the old directory. I am not at all familiar with VB coding and modules, I did however manage to get behind the disabled settings to take a look at the
    script.

    I have included the VB below, and just wanted to know, where would I have to update in the VB, so that it's importing from the right path? Thanks, your help would be greatly appreciated.

    Option Compare Database
    Option Explicit


    Function fTableExists(strTableName As String) As Boolean



    Dim tbl As TableDef

    fTableExists = False

    For Each tbl In currentdb.TableDefs
    If tbl.Name = strTableName Then
    fTableExists = True
    Exit Function
    End If
    Next tbl


    '

    '

    End Function

    Function delTables(strTableName As String)

    'On Error GoTo Err

    If fTableExists(strTableName) Then
    DoCmd.DeleteObject acTable, strTableName
    End If

    currentdb.TableDefs.Refresh

    'Err:
    ' MsgBox "An error has occurred." & vbCrLf & "Please make sure all Table are closed. "
    ' MsgBox Error
    ' Exit Function

    'addfields (strTablename)
    End Function
    Function updqAvgDailyVisit()
    Dim db As Database
    Dim strsql As String
    Dim dteyr As String

    'Dim dteyear As String
    Dim strYR As String
    Dim strAvgDailyVisit As String
    'Dim strqAvgDailyVisit As String
    Dim strsqlqend As String

    On Error GoTo Err
    Set db = currentdb
    strAvgDailyVisit = "Avg Daily Visit "
    'dteyr = Date

    dteyr = Format(Date, "yyyy")
    strYR = "(" & dteyr & "YTD)"
    strAvgDailyVisit = "[" & strAvgDailyVisit & strYR & "]"


    'strqAvgDailyVisit = strAvgDailyVisit & strYR
    strsqlqend = "BI_Excel_Rpt." & strAvgDailyVisit
    strsql = "UPDATE BI_Excel_Rpt INNER JOIN [BI Clinic ID Avg Visit] ON BI_Excel_Rpt.CLINIC = [BI Clinic ID Avg Visit].[Clinic ID] SET "
    strsqlqend = strsqlqend & " = [BI Clinic ID Avg Visit]." & strAvgDailyVisit
    strsql = strsql & strsqlqend & ";"



    db.Execute (strsql)
    Exit Function
    Set db = Nothing

    Err:
    MsgBox "An error has occurred." & vbCrLf & "Please make sure the year in the " & vbCrLf & "Avg Daily Visit (XXXXYTD) field is correct in the Avg Table."
    'MsgBox Error
    Exit Function

    End Function

    Function addfields(strTableName As String)
    Dim db As Database
    Dim tdf As TableDef
    Dim fld As Field

    Set db = currentdb
    Set tdf = db.TableDefs(strTableName)
    'fld = "Hospital"

    'Set NewTable = MyDatabase.CreateTableDef("BI Open Visit")
    With tdf
    .Fields.Append .CreateField("Hospital", dbText, 50)
    '.Fields("Hospital").OrdinalPosition = 0 '.OrdinalPosition = 1
    .Fields.Append .CreateField("Service Type", dbText, 50)
    '.Fields("Service Type") = OrdinalPosition = 1
    '.Fields.Append .CreateField("Site", dbText, 25)

    End With


    ' Set db = Nothing
    End Function
    Function imptable(strTableName As String)
    Dim strdrive As String
    Dim strfileName As String


    DoCmd.SetWarnings False

    'strdrive = "C:\WINNT\Profiles\CAmerine\My Documents\" '
    'strdrive = "C:\Documents and Settings\GBonapar\My Documents\BitDev\Revenue\"
    strdrive = "H:\CAMER\Open Visit Reports\"
    strfileName = "Aging Open Visit Tables.mdb"



    DoCmd.TransferDatabase acImport, "Microsoft ACCESS", strdrive & strfileName, acTable, strTableName, strTableName, False
    currentdb.TableDefs.Refresh


    End Function


    Function exptbl(strTableName As String)
    Dim strdrive As String
    Dim strfileName As String
    Dim dte As String


    On Error GoTo Err_expBidata

    'dte = Format(Date, "_mdd")


    'strdrive = "H:\Share5vs\Share5vl\waterst1\Common\Pat_all\ Pas-pat_acct\CAMER\Open Visit Reports\"
    ' strdrive = "C:\Documents and Settings\GBonapar\My Documents\BitDev\Revenue\"
    strdrive = "H:\CAMER\Open Visit Reports\"
    strfileName = strTableName & ".xls"


    DoCmd.SetWarnings False

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strTableName, strdrive & strfileName, True

    Exit_Sub:
    Exit Function

    Err_expBidata:
    Select Case Err.Number
    Case Else
    MsgBox "There was a problem exporting file " & strfileName & Chr(13) & _
    Err.Description, , "Error " & Err.Number

    End Select
    DoCmd.SetWarnings True

    End Function

    Function XlAddfieldsBI(strTableName As String)
    Dim db As Database
    Dim tblXL As TableDef
    Dim dteyr As Date

    'Dim dteyr As String
    Dim strYR As String
    Dim strAvgDailyVisit As String




    Set db = currentdb
    Set tblXL = db.TableDefs(strTableName)
    strAvgDailyVisit = "Avg Daily Visit "
    dteyr = Date

    strYR = Format(dteyr, "yyyy")

    strYR = "(" & strYR & "YTD)"
    strAvgDailyVisit = strAvgDailyVisit & strYR


    'Set NewTable = MyDatabase.CreateTableDef("BI Open Visit")
    With tblXL

    .Fields.Append .CreateField("Description", dbText, 50)
    '.Fields("Description").OrdinalPosition = .Fields(3).OrdinalPosition
    .Fields.Append .CreateField(strAvgDailyVisit, dbInteger, 50) '.OrdinalPosition = 6
    '.Fields(strAvgDailyVisit).OrdinalPosition = 5
    '.Fields("30+ Days").OrdinalPosition = 9
    .Fields.Refresh


    End With

    Set tblXL = Nothing
    Set db = Nothing



    End Function


    Function chgfldposBI(strTableName As String)
    Dim db As DAO.Database
    Dim tblXL As DAO.TableDef
    Dim fld As DAO.Field

    Dim dteyr As Date
    Dim strYR As String
    Dim strAvgDailyVisit As String

    Set db = currentdb
    Set tblXL = db.TableDefs(strTableName)


    'Dim dteyr As String


    strAvgDailyVisit = "Avg Daily Visit "
    dteyr = Date

    strYR = Format(dteyr, "yyyy")

    strYR = "(" & strYR & "YTD)"
    strAvgDailyVisit = strAvgDailyVisit & strYR

    With tblXL

    .Fields(0).OrdinalPosition = 5
    .Fields(1).OrdinalPosition = 6
    .Fields(2).OrdinalPosition = 7
    .Fields(3).OrdinalPosition = 8
    .Fields(4).OrdinalPosition = 0
    .Fields(5).OrdinalPosition = 1
    .Fields(6).OrdinalPosition = 2
    .Fields(7).OrdinalPosition = 9
    .Fields(8).OrdinalPosition = 10
    .Fields(9).OrdinalPosition = 11
    .Fields(10).OrdinalPosition = 3
    .Fields(11).OrdinalPosition = 4
    .Fields.Refresh

    End With



    Set fld = Nothing
    Set tblXL = Nothing
    Set db = Nothing


    End Function

    Function XlAddfields(strTableName As String)
    Dim db As Database
    Dim tblXL As TableDef


    Set db = currentdb
    Set tblXL = db.TableDefs(strTableName)

    With tblXL

    .Fields.Append .CreateField("Description", dbText, 50)
    '.Fields("Description").OrdinalPosition = .Fields(3).OrdinalPosition

    .Fields.Refresh


    End With


    Set tblXL = Nothing
    db.Close
    Set db = Nothing


    End Function

    Function chgfldpos(strTableName As String)
    Dim db As Database
    Dim tblXL As TableDef

    Set db = currentdb
    Set tblXL = db.TableDefs(strTableName)

    With tblXL

    .Fields(0).OrdinalPosition = 4
    .Fields(1).OrdinalPosition = 5
    .Fields(2).OrdinalPosition = 6
    .Fields(3).OrdinalPosition = 7
    .Fields(4).OrdinalPosition = 0
    .Fields(5).OrdinalPosition = 1
    .Fields(6).OrdinalPosition = 2
    .Fields(7).OrdinalPosition = 8
    .Fields(8).OrdinalPosition = 9
    .Fields(9).OrdinalPosition = 10
    .Fields(10).OrdinalPosition = 3

    .Fields.Refresh

    End With

    Set tblXL = Nothing
    db.Close
    Set db = Nothing





    End Function
    Last edited by Murdock; 11-29-09 at 23:10.

  2. #2
    Join Date
    Oct 2002
    Location
    Baghdad, Iraq
    Posts
    697
    I am not at all familiar with VB coding and modules,
    But you've used Windows for more than 30 minutes and you know what a file path looks like, right?

    There are 2 places in the code where a path is assigned to a variable.

    It may also help to know that a single quote begins a comment. So VB ignores everything after ', and if ' appears at the beginning of a line, the whole line is ignored.

  3. #3
    Join Date
    Nov 2009
    Posts
    2
    Quote Originally Posted by sco08y View Post
    But you've used Windows for more than 30 minutes and you know what a file path looks like, right?

    There are 2 places in the code where a path is assigned to a variable.

    It may also help to know that a single quote begins a comment. So VB ignores everything after ', and if ' appears at the beginning of a line, the whole line is ignored.
    Thanks for the reply, if I am not mistaken, you're saying, I would have to update the 2 places in the code where a path is assigned to a variable? e.g., strdrive = "H:\CAMER\Open Visit Reports\"

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •