T
TereseSchuts
hello!
I have a new laptop and I am trying to open my Access program. I am IT challenged to say the least and I need some help.. thank you in advance.. I keep getting the above statement and this
Option Compare Database
Option Explicit
Global glngJobDescID As Variant
Global gstrJobDescNo As String
Global gstrUserName As String
Global glngNewNumber As Long
Global gstrCriteria As String
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function apiGetComputerName Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function isLoaded(strFrmName As String) As Boolean
'isLoaded = SysCmd(SYSCMD_GETOBJECTSTATE, acForm, strFrmName)
If CurrentProject.AllForms(strFrmName).isLoaded Then
If Forms(strFrmName).CurrentView > 0 Then
'loaded in any view aside from DESIGN VIEW
isLoaded = True
End If
End If
End Function
Function ShowCurrentUser()
MsgBox "The Current User is: " & CurrentUser()
End Function
Function fOSUserName() As Variant
Dim lngLen As Long, lngX As Long
Dim strUserName As String
Dim rs As Recordset
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If lngX <> 0 Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = "Anonymous@" & fOSMachineName()
End If
Set rs = Nothing
End Function
Function SetGrpFtrLoc(rpt As Access.Report, dblGrpFtrLoc As Double)
'Convert inches to twips
'dblGrpFtrLoc = dblGrpFtrLoc * 1440
'Convert centimeters to twips
dblGrpFtrLoc = dblGrpFtrLoc * 567
If rpt.Top < dblGrpFtrLoc Then
rpt.MoveLayout = True
rpt.NextRecord = False
rpt.PrintSection = False
End If
End Function
Function fSelModule(stModule) As String
If IsNumeric(Mid(stModule, 3, 1)) Then fSelModule = stModule Else fSelModule = Left(stModule, 2)
End Function
Function CreateQuery(strQryName As String, strSQL As String) As Boolean
On Error GoTo CreateQuery_Error
Dim db As Database
Dim qdf As QueryDef
Dim intErr As Integer
On Error Resume Next
Set db = CurrentDb()
Set qdf = db.CreateQueryDef(strQryName, strSQL)
intErr = Err
If intErr <> 0 Then
Set qdf = Nothing
DoCmd.DeleteObject acQuery, strQryName
Else
CreateQuery = True
GoTo CreateQuery_Exit
End If
On Error GoTo CreateQuery_Error
Set qdf = db.CreateQueryDef(strQryName, strSQL)
CreateQuery = True
CreateQuery_Exit:
Set qdf = Nothing
Set db = Nothing
Exit Function
CreateQuery_Error:
CreateQuery = False
MsgBox "OOPS! a Query Error" & Chr(13) & Err & ": " & Err.Description, vbCritical, "Create Query"
Resume CreateQuery_Exit
End Function
Function fOSMachineName() As String
' This code was originally written by Dev Ashish.
' 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
' Dev Ashish
'
'Returns the computername
Dim lngLen As Long, lngX As Long
Dim strCompName As String
lngLen = 16
strCompName = String$(lngLen, 0)
lngX = apiGetComputerName(strCompName, lngLen)
If lngX <> 0 Then
fOSMachineName = Left$(strCompName, lngLen)
Else
fOSMachineName = ""
End If
End Function
Continue reading...
I have a new laptop and I am trying to open my Access program. I am IT challenged to say the least and I need some help.. thank you in advance.. I keep getting the above statement and this
Option Compare Database
Option Explicit
Global glngJobDescID As Variant
Global gstrJobDescNo As String
Global gstrUserName As String
Global glngNewNumber As Long
Global gstrCriteria As String
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function apiGetComputerName Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function isLoaded(strFrmName As String) As Boolean
'isLoaded = SysCmd(SYSCMD_GETOBJECTSTATE, acForm, strFrmName)
If CurrentProject.AllForms(strFrmName).isLoaded Then
If Forms(strFrmName).CurrentView > 0 Then
'loaded in any view aside from DESIGN VIEW
isLoaded = True
End If
End If
End Function
Function ShowCurrentUser()
MsgBox "The Current User is: " & CurrentUser()
End Function
Function fOSUserName() As Variant
Dim lngLen As Long, lngX As Long
Dim strUserName As String
Dim rs As Recordset
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If lngX <> 0 Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = "Anonymous@" & fOSMachineName()
End If
Set rs = Nothing
End Function
Function SetGrpFtrLoc(rpt As Access.Report, dblGrpFtrLoc As Double)
'Convert inches to twips
'dblGrpFtrLoc = dblGrpFtrLoc * 1440
'Convert centimeters to twips
dblGrpFtrLoc = dblGrpFtrLoc * 567
If rpt.Top < dblGrpFtrLoc Then
rpt.MoveLayout = True
rpt.NextRecord = False
rpt.PrintSection = False
End If
End Function
Function fSelModule(stModule) As String
If IsNumeric(Mid(stModule, 3, 1)) Then fSelModule = stModule Else fSelModule = Left(stModule, 2)
End Function
Function CreateQuery(strQryName As String, strSQL As String) As Boolean
On Error GoTo CreateQuery_Error
Dim db As Database
Dim qdf As QueryDef
Dim intErr As Integer
On Error Resume Next
Set db = CurrentDb()
Set qdf = db.CreateQueryDef(strQryName, strSQL)
intErr = Err
If intErr <> 0 Then
Set qdf = Nothing
DoCmd.DeleteObject acQuery, strQryName
Else
CreateQuery = True
GoTo CreateQuery_Exit
End If
On Error GoTo CreateQuery_Error
Set qdf = db.CreateQueryDef(strQryName, strSQL)
CreateQuery = True
CreateQuery_Exit:
Set qdf = Nothing
Set db = Nothing
Exit Function
CreateQuery_Error:
CreateQuery = False
MsgBox "OOPS! a Query Error" & Chr(13) & Err & ": " & Err.Description, vbCritical, "Create Query"
Resume CreateQuery_Exit
End Function
Function fOSMachineName() As String
' This code was originally written by Dev Ashish.
' 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
' Dev Ashish
'
'Returns the computername
Dim lngLen As Long, lngX As Long
Dim strCompName As String
lngLen = 16
strCompName = String$(lngLen, 0)
lngX = apiGetComputerName(strCompName, lngLen)
If lngX <> 0 Then
fOSMachineName = Left$(strCompName, lngLen)
Else
fOSMachineName = ""
End If
End Function
Continue reading...
