MyTetra Share
Делитесь знаниями!
Определить имя компьютера m_Name_User_Comp
Время создания: 28.05.2020 11:25
Текстовые метки: GetVersion ComputerName, GetComputerName
Раздел: !Закладки - VBA

Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function fun_GetCompName() As String

Dim scomp As String, h

scomp = Space(255)

h = GetComputerName(scomp, 255)

fun_GetCompName = Trim(scomp)

End Function


Sub test()

Dim scomp As String

scomp = Space(255)

h = GetComputerName(scomp, 255)

MsgBox Trim(scomp)

End Sub



Function fun_GetUserName() As String

fGetUserName = VBA.Environ("UserName")

End Function



'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

'##### разрешения по пользователям

'Sub testFnGetUserName()

'ff = FnGetUserName()

'End Sub

Function FnGetUserName() As Boolean

Dim strUserName As String

strUserName = VBA.Environ("UserName")

Select Case strUserName

Case "username": FnGetUserName = True

Case "username": FnGetUserName = True

Case "username": FnGetUserName = True

Case "username": FnGetUserName = True

Case Else: FnGetUserName = False

End Select

End Function

'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\




'Вариант с отправкой через Outlook.


Public Sub sendmail()

' Dim OutApp, OutMail As Object

' Dim Out_Mail As String

' Set OutApp = CreateObject("Outlook.Application")

' Set OutMail = OutApp.CreateItem(0)

Dim olApp As Object 'Outlook.Application

Dim objMail As Object 'Outlook.MailItem

Set olApp = Outlook.Application

'Create e-mail item

Set objMail = olApp.CreateItem(olMailItem)


With objMail

'Set body format to HTML

.To = "example@mail.ru"

.BodyFormat = olFormatPlain

.body = "Helo, World"

.Send

End With

End Sub


'Можно использовать не .send, а .display, тогда подготовленное письмо будет ждать отправки вручную.




'взято с сайта http://codevb.narod.ru/windows_7.html

'----------------------------------------------------------------------

'Пример использования

'MsgBox CompName

'MsgBox UserName

'----------------------------------------------------------------------




'Declare Function GetActiveWindow Lib "user32" () As Long

'Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long

''

''Private Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

''Private Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

''

'''Получаем имя компьютера

''Public Function CompName() As String

'' Dim r As Long

'' Dim sCompName As String

'' Dim slength As Long

''

'' slength = 255

'' sCompName = String$(slength, vbNullChar)

'' r = GetComputerName(sCompName, slength)

'' CompName = Left$(sCompName, InStr(sCompName, vbNullChar) - 1)

''End Function

''

'''Получаем имя пользователя

''Public Function UserName() As String

'' Dim r As Long

'' Dim sUserName As String

'' Dim slength As Long

''

'' slength = 255

'' sUserName = String$(slength, vbNullChar)

'' r = GetUserName(sUserName, slength)

'' UserName = Left$(sUserName, InStr(sUserName, vbNullChar) - 1)

''End Function




'функция LCase конвертирует строку в нижний регистр. UCase - в верхний.

'ф-я InStr возвращает позицию символа в строке.

'ф-я Left возвращает нужное кол-во символов с левой стороны строки.


Dim SearchString As String, SearchChar As String, MyPos As Integer, Comp As String

SearchString = "ПЕТЯ-ПК"

SearchChar = "-"

MyPos = InStr(SearchString, SearchChar)

Comp = Left(SearchString, MyPos - 1)

Comp = LCase(Comp)





Так же в этом разделе:
 
MyTetra Share v.0.53
Яндекс индекс цитирования