I was using environ("username"), then moved to:
Private Declare PtrSafe 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 = vbNullString
End If
End Function
But I want to be able to check what the domain is, and if it is an actual domain or just a local machine name etc... Is this possible?
I've already had discussions regarding setting up domain groups/security groups etc, so do not need input regarding these thank you.
well, Environ("USERDOMAIN") should get the domain name, but if you want to use api declarations, then you would need:
Private Declare Function LookupAccountName Lib "advapi32" Alias "LookupAccountNameA" (ByVal lpSystemName As String, _
ByVal lpAccountName As String, Sid As Byte, cbSid As Long, ByVal DomainName As String, _
cbDomainName As Long, peUse As Long) As Long
an example can be found here
Related
Hi I'm trying to download a zip in a local server using VBA. My code works great in my PC but at the server doesn't work. Heres's the code:
PS. Cell A7 is the link of the download.
Dim downloadStatus As Variant
Dim url As String
Dim destinationFile_local As String
url = [A7]
destinationFile_local = "C:\Users\omayorga\Downloads\" & fileName([A7])
downloadStatus = URLDownloadToFile(0, url, destinationFile_local, 0, 0)
If downloadStatus = 0 Then
MsgBox "Downloaded Succcessfully!"
Else
MsgBox "Download failed"
End If
End Sub
Function fileName(file_fullname) As String
fileName = Mid(file_fullname, InStrRev(file_fullname, "/") + 1)
End Function
Any suggestion? Thanks so much
You have this in your code, you need:
Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Check your download link, the same said Raymond Wu your destinationFile_local, tested here your code works.
refer link
How do I download a file using VBA (without Internet Explorer)
If an open workbook (located on a server) is in read only mode, how can I display the active username using VBA?
I've looked into .WriteReservedBy but this only shows the name of the person that last saved the file with a password.
This should probably be a comment but my reputation is too low
I've seen this but never needed the info...
Things to try:
ThisWorkbook.UserStatus - array with all current users for the file open as exclusive or shared
Environ("USERNAME")
CreateObject("WScript.NetWork").UserName
API calls:
.
Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA"
( _
ByVal lpName As String, _
ByVal lpUserName As String, _
lpnLength As Long
) As Long
Declare Function GetUserName& Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long)
.
more details about these APIs:
https://support.microsoft.com/en-us/kb/161394
http://www.vbaexpress.com/kb/getarticle.php?kb_id=768
WMI Win32_NetworkConnection:
Public Function GetActiveUser(Optional ByVal computer As String = ".") As String
Dim wmi As Object, itm As String
On Error Resume Next
Set wmi = GetObject("winmgmts:\\" & computer & "\Root\CIMv2")
itm = wmi.ExecQuery("Select UserName from Win32_NetworkConnection", , 48)
GetNetActiveUser = itm
End Function
I have the following code declared:
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
And i have a function to access it as follows:
Private Function ReadIniFileString(ByVal Sect As String, ByVal Keyname As String) As String
Dim Worked As Long
Dim RetStr As String * 128
Dim StrSize As Long
Dim iNoOfCharInIni As Long
Dim sIniString As String
Dim sProfileString As String
iNoOfCharInIni = 0
sIniString = ""
If Sect = "" Or Keyname = "" Then
MsgBox "Section Or Key To Read Not Specified !!!", vbExclamation, "INI"
Else
sProfileString = ""
RetStr = Space(128)
StrSize = Len(RetStr)
Worked = GetPrivateProfileString(Sect, Keyname, "", RetStr, StrSize, IniFileName)
If Worked Then
iNoOfCharInIni = Worked
sIniString = Left$(RetStr, Worked)
End If
End If
ReadIniFileString = sIniString
End Function
This works under 2007, but i get an error on Excel 2010 at the:
Worked = GetPrivateProfileString(Sect, Keyname, "", RetStr, StrSize, IniFileName)
i get an "Can't find sub or function error" I have seen on the web that i should be able to fix this via declaring the function at PtrSafe, and returning a LongPtr. I've done that but get the same results!
Any help please!
Thanks so much!
Russ
To make this work in a 64 bit version of Excell you need to add the PtrSafe Attribute to the function Declaration like so:
Declare PtrSafe Function GetPrivateProfileString Lib "kernel32" Alias...
You don't say whether Excel 2010 is 32 bits or 64. I'm not sure what would happen if a VBA module running in a 64 bit instance of Excel would do if it tried to call a 32 bit routine, and kernel32.dll is a 32 bit library. Since GetPrivatePorfileString is deprecated, I suspect it didn't get ported to the 64 bit counterpart of kernel32.dll.
This is the correct code. I hope works!
Private Declare PtrSafe Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" ( _
ByVal lpAppName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long
I have a listbox called lstSerial and a textbox called txtSerials. What I want to do is search lstSerial for the string that's entered in txtSerials. I'm using VB6 in Microsoft Visual Basic 6.0, and I'm having a terrible time finding documentation.
Thanks.
#AlexK's answer is technically correct - yes - it will work, but it's not the preferred way to go. There is an API call for this very purpose:
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As _
Integer, ByVal lParam As Any) As Long
'constants for searching the ListBox
Private Const LB_FINDSTRINGEXACT = &H1A2
Private Const LB_FINDSTRING = &H18F
'function to get find an item in the Listbox
Public Function GetListBoxIndex(hWnd As Long, SearchKey As String, Optional FindExactMatch As Boolean = True) As Long
If FindExactMatch Then
GetListBoxIndex = SendMessage(hWnd, LB_FINDSTRINGEXACT, -1, ByVal SearchKey)
Else
GetListBoxIndex = SendMessage(hWnd, LB_FINDSTRING, -1, ByVal SearchKey)
End If
End Function
So you want to do this:
lstSerial.ListIndex = GetListBoxIndex(lstSerial.hWnd, txtSerials.Text)
Source
Docs; http://msdn.microsoft.com/en-us/library/aa267225(v=VS.60).aspx
dim find as string,i as long,found as boolean
find=txtSerials.text
for i=0 to lstserial.listcount - 1
if strcomp(find, lstSerial.list(i), vbTextcompare)=0 then
found = true
lstSerial.setfocus
lstSerial.listindex= i
exit for
end if
next
if not found then msgbox "not found ..."
I am using the CheckTokenMembership Windows API to check if the user is an Administrator.
Here's the code:
Option Explicit
Private Const SECURITY_BUILTIN_DOMAIN_RID As Long = &H20
Private Const DOMAIN_ALIAS_RID_ADMINS As Long = &H220
Private Declare Function AllocateAndInitializeSid Lib "advapi32.dll" (pIdentifierAuthority As Any, ByVal nSubAuthorityCount As Byte, ByVal nSubAuthority0 As Long, ByVal nSubAuthority1 As Long, ByVal nSubAuthority2 As Long, ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As Long, ByVal nSubAuthority5 As Long, ByVal nSubAuthority6 As Long, ByVal nSubAuthority7 As Long, lpPSid As Long) As Long
Private Declare Sub FreeSid Lib "advapi32.dll" (ByVal pSid As Long)
Private Declare Function CheckTokenMembership Lib "advapi32.dll" (ByVal hToken As Long, ByVal pSidToCheck As Long, pbIsMember As Long) As Long
Private Type SID_IDENTIFIER_AUTHORITY
Value(0 To 5) As Byte
End Type
Private Function pvIsAdmin() As Boolean
Dim uAuthNt As SID_IDENTIFIER_AUTHORITY
Dim pSidAdmins As Long
Dim lResult As Long
uAuthNt.Value(5) = 5
If AllocateAndInitializeSid(uAuthNt, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, pSidAdmins) <> 0 Then
If CheckTokenMembership(0, pSidAdmins, lResult) <> 0 Then
pvIsAdmin = (lResult <> 0)
End If
Call FreeSid(pSidAdmins)
End If
End Function
Problem is that on Windows 7 and Windows 2008 SP2, the call to FreeSID is causing the app to crash. The crash is intermittent.
Has anyone encountered this problem?
Thanks!
EDIT:
I just rechecked my code and I found out that I declared FreeSID as such:
Private Declare Sub FreeSid Lib "advapi32.dll" (pSid As Long)
As compared to the above code, the pSid parameter here is not flagged as ByVal. I added the ByVal flag and the problem is no longer present. Somehow, I am not convinced that this fixed the problem. Can this possibly have fixed the problem?
Separate pvIsAdmin in a completely separate module and copy function declarations verbatim from the snippet. In AllocateAndInitializeSid lpPSid is ByRef. In FreeSid param is ByVal.