We help IT Professionals succeed at work.

MSAccess - Get username (excel10 vs excel 11 reference issue)

markp99
markp99 asked
on
726 Views
Last Modified: 2010-06-04
I am grabbing the username as users log into my app using the following method (dev ashish's method):

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function fOSUserName() As String

     ' Returns the network login name
     Dim lngLen As Long, lngX As Long
     Dim strUserName As String
     strUserName = String(254, 0)
     lngLen = 255
     lngX = apiGetUserName(strUserName, lngLen)
     If lngX <> 0 Then
          fOSUserName = Left(strUserName, lngLen - 1)
     Else
          fOSUserName = "unknown_user"
     End If

End Function

This works great for  Office 2003 users, where my reference to Excel11 is valid.  Office 2000 users show a MISSING reference to Excel11 and Access complains about the following line:

     strUserName = String(254, 0)

Function "String" is not recognized.  I'm guessing this is coming from my Excel reference.

Any suggestions to appease my Office2000 users.  I would really like to continue to grab the username to allow me to timestamp their edits.  

Is there an alternate approach that might be immune to the reference issue?

Thanks!
Comment
Watch Question

CERTIFIED EXPERT
Top Expert 2010

Commented:
Hello markp99,

Why have a reference to Excel at all?  This code does not require it...

Regards,

Patrick
Database Architect / Application Developer
CERTIFIED EXPERT
Top Expert 2007
Commented:
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION

Author

Commented:
The Excel reference is required for some excel automation stuff I am doing.
CERTIFIED EXPERT
Top Expert 2010
Commented:
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION

Author

Commented:
mathew,

I use excel automation in a number of instances.  The following is a sample with LOTS of formatting commands snipped out.  Hope thhis is helpful for you to assist with Late Binding idea:


Private Sub btnTrackingReport_Click()

'On Error GoTo Err_Handler

    Dim appXLS As Excel.Application
    Dim wbknew As Excel.Workbook
    Dim wksnew As Excel.Worksheet
   
    TotalSheets = 3 'or whatever
   
    Set appXLS = CreateObject("Excel.Application")
    appXLS.SheetsInNewWorkbook = TotalSheets
    Set wbknew = appXLS.Workbooks.Add
    Set wksnew = wbknew.ActiveSheet
   
    appXLS.Visible = True
    appXLS.UserControl = True
 
    wbknew.Sheets(1).Name = Me!txtAssy
    wbknew.Colors(38) = RGB(255, 0, 102)
    wbknew.Colors(46) = RGB(255, 153, 51)

    wksnew.Range("b4") = "Building Tracking Report..."
   
'XLS PageSetup (margins, headers, footers, landscape, freezepanes)
    wksnew.Range("e7").Select
    appXLS.ActiveWindow.FreezePanes = True
    wksnew.PageSetup.PrintArea = ""
    wksnew.PageSetup.Zoom = 75
    appXLS.ActiveWindow.DisplayGridlines = False
   
>>>snip formatting stuff
'sample formatting shown below...

    With wksnew.Range("j5:q5")
        .MergeCells = True
        .HorizontalAlignment = xlHAlignCenter
        .Font.Size = 8
        .Font.Bold = True
        .Interior.ColorIndex = 15
        .BorderAround Weight:=xlMedium
    End With

   
 '================Data Dump====================
    Dim rs As DAO.Recordset
    Dim PRM As DAO.Parameter

    'Select appropriate Query
>>>snipped report option    
     Set qdf = CurrentDb.QueryDefs("Report - Exceptions Status")

    'Evaluate the parameters from the form references
    For Each PRM In qdf.Parameters
        PRM.Value = Eval(PRM.Name)
    Next
    Set rs = qdf.OpenRecordset(dbOpenSnapshot)

   
    With wksnew
        .Range("b7").CopyFromRecordset rs
    End With
'================Data Dump====================

' Release object references.
    Set oRng = Nothing
    Set wksnew = Nothing
    Set wbknew = Nothing
    Set appXLS = Nothing

   Exit Sub

Err_Handler:
      MsgBox Err.Description, vbCritical, "Error: " & Err.Number

End Sub
Most Valuable Expert 2014
Commented:
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION
CERTIFIED EXPERT
Top Expert 2010

Commented:
Easy enough...




Private Sub btnTrackingReport_Click()

'On Error GoTo Err_Handler

    Dim appXLS As Object 'Excel.Application
    Dim wbknew As Object 'Excel.Workbook
    Dim wksnew As Object 'Excel.Worksheet
   
    TotalSheets = 3 'or whatever
   
    Set appXLS = CreateObject("Excel.Application")
    appXLS.SheetsInNewWorkbook = TotalSheets
    Set wbknew = appXLS.Workbooks.Add
    Set wksnew = wbknew.ActiveSheet
   
    appXLS.Visible = True
    appXLS.UserControl = True
 
    wbknew.Sheets(1).Name = Me!txtAssy
    wbknew.Colors(38) = RGB(255, 0, 102)
    wbknew.Colors(46) = RGB(255, 153, 51)

    wksnew.Range("b4") = "Building Tracking Report..."
   
'XLS PageSetup (margins, headers, footers, landscape, freezepanes)
    wksnew.Range("e7").Select
    appXLS.ActiveWindow.FreezePanes = True
    wksnew.PageSetup.PrintArea = ""
    wksnew.PageSetup.Zoom = 75
    appXLS.ActiveWindow.DisplayGridlines = False
   
>>>snip formatting stuff
'sample formatting shown below...

    With wksnew.Range("j5:q5")
        .MergeCells = True
        .HorizontalAlignment = -4108 'xlHAlignCenter
        .Font.Size = 8
        .Font.Bold = True
        .Interior.ColorIndex = 15
        .BorderAround Weight:=-4138 'xlMedium
    End With

   
 '================Data Dump====================
    Dim rs As DAO.Recordset
    Dim PRM As DAO.Parameter

    'Select appropriate Query
>>>snipped report option    
     Set qdf = CurrentDb.QueryDefs("Report - Exceptions Status")

    'Evaluate the parameters from the form references
    For Each PRM In qdf.Parameters
        PRM.Value = Eval(PRM.Name)
    Next
    Set rs = qdf.OpenRecordset(dbOpenSnapshot)

   
    With wksnew
        .Range("b7").CopyFromRecordset rs
    End With
'================Data Dump====================

' Release object references.
    Set oRng = Nothing
    Set wksnew = Nothing
    Set wbknew = Nothing
    Set appXLS = Nothing

   Exit Sub

Err_Handler:
      MsgBox Err.Description, vbCritical, "Error: " & Err.Number

End Sub

Author

Commented:
Patrick,

To summarize, I see you've changes the following lines:


    Dim appXLS As Object 'Excel.Application
    Dim wbknew As Object 'Excel.Workbook
    Dim wksnew As Object 'Excel.Worksheet

And then adjusted the following:

        .HorizontalAlignment = -4108 'xlHAlignCenter
        .BorderAround Weight:=-4138 'xlMedium

Were there other changes I missed?

As I use dozens of other formatting statements I've snipped out, is there a reference to the numeric equivalents??

Thanks!

Author

Commented:
I can see in  the immediate window:

?xlright
-4152

Is there a summary somewhere?
CERTIFIED EXPERT
Top Expert 2010

Commented:
markp99 said:
>>Is there a summary somewhere?

The easiest way to get the constant values is to go to Excel, launch the VB Editor, and hit
F2 to bring up the Object Explorer.
CERTIFIED EXPERT
Top Expert 2010

Commented:
markp99,

And sorry about missing xlRight :)

Regards,

Patrick

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a sample view!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.