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)
