I've created a userform that sends as many as 17 fields, not all required, to a table. It works awesome except when my work associate opens it up on his 64 bit machine. Most of us use 32 bit. Something about his machine that runs Windows and Mac. I don't that is the issue, just it needs to be 64 bit compatible. And I have no clue how to do that. I've been trying to decipher the websites and other links from MrExcel forums trying to figure it out. I just found out I'm not the smartest man in the world. Hmmm
I'll include all the code here. There isn't anything that gives away my company IP.
Your help in solving this is most appreciated.
This is in Module1
Not sure where I grabbed the above code from but A.Vials, Sly have my thanks.
This is in the Userform code
Thank you
-- g
I'll include all the code here. There isn't anything that gives away my company IP.
Your help in solving this is most appreciated.
This is in Module1
VBA Code:
Sub MyCell()
'originally coded as VB script by A.Vials, converted to VBA by Sly
Dim objInfo
Dim strLDAP
Dim strFullName
Set objInfo = CreateObject("ADSystemInfo")
strLDAP = objInfo.UserName
Set objInfo = Nothing
strFullName = GetUserName(strLDAP)
Worksheets("Engine").Range("B6") = strFullName '<== Adjust cell Reference
End Sub
Function GetUserName(strLDAP)
Dim objUser
Dim strName
Dim arrLDAP
Dim intIdx
On Error Resume Next
strName = ""
Set objUser = GetObject("LDAP://" & strLDAP)
If Err.Number = 0 Then
strName = objUser.Get("givenName") & Chr(32) & objUser.Get("sn")
End If
If Err.Number <> 0 Then
arrLDAP = Split(strLDAP, ",")
For intIdx = 0 To UBound(arrLDAP)
If UCase(Left(arrLDAP(intIdx), 3)) = "CN=" Then
strName = Trim(Mid(arrLDAP(intIdx), 4))
End If
Next
End If
Set objUser = Nothing
GetUserName = strName
End Function
This is in the Userform code
VBA Code:
Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As Long
Private Declare Function GetWindowLong _
Lib "user32" _
Alias "GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) _
As Long
Private Declare Function SetWindowLong _
Lib "user32" _
Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As Long
Private Declare Function DrawMenuBar _
Lib "user32" ( _
ByVal hWnd As Long) _
As Long
Private Const GWL_STYLE As Long = (-16)
Private Const WS_SYSMENU As Long = &H80000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Sub cmdSubmit_Click()
' when we use the Continue button
Dim TargetRow As Integer 'variable for position control
TargetRow = Sheets("Engine").Range("B3").Value + 1 'make variable equal to COUNTA formula on worksheet
''''BEGIN INPUT DATA INTO DATABASE'''
Sheets("Data").Range("DataStart").Offset(TargetRow, 0).Value = TargetRow 'Ref
Sheets("Data").Range("DataStart").Offset(TargetRow, 1).Value = lbInputDate 'tbDate 'Date
'Sheets("Data").Range("DataStart").Offset(TargetRow, 2).Value = lbInputTime 'tbDate 'Date
Sheets("Data").Range("DataStart").Offset(TargetRow, 3).Value = lbUser 'Age
Sheets("Data").Range("DataStart").Offset(TargetRow, 4).Value = tbTicket 'Age
Sheets("Data").Range("DataStart").Offset(TargetRow, 5).Value = tbAccount 'Gender combo box
Sheets("Data").Range("DataStart").Offset(TargetRow, 6).Value = tbOrder 'Region combo box
Sheets("Data").Range("DataStart").Offset(TargetRow, 7).Value = cbAffiliate 'Job combo box
Sheets("Data").Range("DataStart").Offset(TargetRow, 8).Value = cbVia 'Driving combo box
Sheets("Data").Range("DataStart").Offset(TargetRow, 9).Value = cbOrigin 'Smoking combo box
Sheets("Data").Range("DataStart").Offset(TargetRow, 10).Value = cbQueue 'Exercist text box
Sheets("Data").Range("DataStart").Offset(TargetRow, 11).Value = cbWho 'Marital Status combo box
Sheets("Data").Range("DataStart").Offset(TargetRow, 12).Value = cbEmail 'Age
Sheets("Data").Range("DataStart").Offset(TargetRow, 13).Value = cbOutbound 'Age
Sheets("Data").Range("DataStart").Offset(TargetRow, 14).Value = cbBILLING 'Exercist text box
Sheets("Data").Range("DataStart").Offset(TargetRow, 15).Value = cbExistingPatient 'Marital Status combo box
Sheets("Data").Range("DataStart").Offset(TargetRow, 16).Value = cbNewPatient 'Age
Sheets("Data").Range("DataStart").Offset(TargetRow, 17).Value = cbNoSale 'Age
'''END INPUT DATA INTO DATABASE'''
Unload ufDispositioner 'makes uf disappear
MsgBox "Your disposition has been added to the database.", 0, "Complete"
End Sub
''''' More code from the net with no name to give credit to
Private Sub Test()
Dim strUser As String * 50
Dim lngDummy As Long
lngDummy = GetUserName(strUser, 49)
Worksheets("Engine").Range("B6").Value = strUser
End Sub
'The following procedure adds the min and max buttons to your form when it activates. Add it to your form's code module (or add the code to your existing UserForm_Activate procedure if you have one):
Private Sub UserForm_Activate()
Dim Frmhdl As Long
Dim lStyle As Long
Frmhdl = FindWindow(vbNullString, Me.Caption)
lStyle = GetWindowLong(Frmhdl, GWL_STYLE)
lStyle = lStyle Or WS_SYSMENU
lStyle = lStyle Or WS_MINIMIZEBOX
lStyle = lStyle Or WS_MAXIMIZEBOX
SetWindowLong Frmhdl, GWL_STYLE, (lStyle)
DrawMenuBar Frmhdl
Application.UserName = Worksheets("Engine").Range("B6").Value
lbInputDate.Caption = Worksheets("Engine").Range("B1").Value
lbInputTime.Caption = Worksheets("Engine").Range("B2").Value
Call MyCell
lbUser.Caption = Worksheets("Engine").Range("B6").Value
End Sub
Private Sub cmdQuit_Click()
Unload ufDispositioner
End Sub
Thank you
-- g