Retorna o Número serial do HD do computador
Saberexcel - Dicas do aplicativo microsoft Excel VBA

Esta macro com as funções e declarações retorna uma mensagem com o número do HD do
seu computador mostro aqui duas funções.

Private Declare Function GetVolumeInformation& Lib "Kernel32" Alias "GetVolumeInformationA" _
(ByVal lpRootPathName As String, _
ByVal pVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemName As Long)

Private Const MAX_FILENAME_LEN = 256

Public Function GetSerialNumber(sDrive As String) As Long
Dim ser As Long
Dim s As String * MAX_FILENAME_LEN
Dim s2 As String * MAX_FILENAME_LEN
Dim j As Long
Dim i As Long

Call GetVolumeInformation _
(sDrive + ":\", s, MAX_FILENAME_LEN, ser, i, j, s2, MAX_FILENAME_LEN)
GetSerialNumber = ser
End Function

Sub Teste_Numero_HD()
MsgBox ("Número do HD ") & GetSerialNumber("C"), vbInformation, "Saberexcel - o site das macros"
MsgBox ("Número do HD ") & DriveSerialNumber("c"), vbInformation, "Saberexcel - o site das macros"
End Sub

Function DriveSerialNumber(Lecteur)
Dim sab, d
Set sab = CreateObject("Scripting.FileSystemObject")
Set d = sab.GetDrive(sab.GetDriveName _
(sab.GetAbsolutePathName(Lecteur & ":\")))
DriveSerialNumber = d.SerialNumber
End Function


Aprenda tudos sobre o Aplicativo microsoft Excel VBA - com SaberExcel

Compras na internet com segurança e garantia nas Lojas Submarino

Saberexcel - O Site das Macros
Essas macros com declarações do Aplicativo Microsoft Excel VBA, ocultam e ou mostram a barra de tarefas do Windows, ferramenta tarefa

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Option Explicit
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40

Sub Ocultar_barra_tarefa_windows()
SetWindowPos FindWindow("Shell_traywnd", ""), 0, 0, 0, 0, 0, SWP_HIDEWINDOW
End Sub

Sub Mostrar_barra_tarefa_windows()
SetWindowPos FindWindow("Shell_traywnd", ""), 0, 0, 0, 0, 0, SWP_SHOWWINDOW
End Sub


Aprenda Aplicativo Microsoft Excel VBA ---((SaberExcel ))---

Mostra os arquivos ativos na memória(Ram)
Saberexcel - dicas aplicativo microsoft excel vba macros

Estas declarações com a macro mostra todos os arquivos que estão
na memória RAM do seu computador, cria uma planilha com a relação

'****************** declarações*******
Private Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" _
Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long

Const GW_HWNDFIRST = 0
Const GW_HWNDNEXT = 2

Sub Load_Lista_Memoria()
Dim CurrWnd As Long
Dim Length As Long
Dim TaskName As String
Dim Parent As Long

i = 1
Sheets.Add 'adiciona uma nova planilha para receber os dados
twnd& = FindWindow("Shell_traywnd", vbNullString)
CurrWnd = GetWindow(twnd, GW_HWNDFIRST)

While CurrWnd <> 0
Length = GetWindowTextLength(CurrWnd)
TaskName = Space$(Length + 1)
Length = GetWindowText(CurrWnd, TaskName, Length + 1)
TaskName = Left$(TaskName, Len(TaskName) - 1)

If Length > 0 Then
Cells(i, 1).Value = TaskName
i = i + 1
End If
CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
DoEvents
Wend
'mensagem na planilha inserida
ActiveSheet.Range("E8").Value = "Nova Planilha inserida com a relação de todos ítens ativos na memória RAM"
Columns("A").AutoFit 'Ajusta a coluna A
End Sub

Aprenda tudo sobre o aplicativo Microsoft Excel VBA - com SaberExcel

Retorna o nome do usuário e nome máquina
Saberexcel - Dicas microsoft Excel VBA

Estas macros com as declarações e funções retorna o nome do usuario e o nome do máquina

Option Explicit

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

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

Sub Teste_Usuario_host()
MsgBox "Usuário: [" & Nome_Usuario & "] e " & "Nome da Máquina [" & Nome_Maquina & " ]", _
vbInformation, "Saberexcel - o site das macros"
End Sub

Function Nome_Usuario() As String
Dim Buffer As String * 256
Dim BuffLen As Long
BuffLen = 256
If GetUserName(Buffer, BuffLen) Then _
Nome_Usuario = Left(Buffer, BuffLen - 1)
End Function

Function Nome_Maquina() As String
Dim Buffer As String * 256
Dim BuffLen As Long
Dim lngX As Long
Dim strCompName As String
BuffLen = 255

If GetComputerName(Buffer, BuffLen) Then _
Nome_Maquina = Left(Buffer, BuffLen)
End Function


Aprenda tudo sobre o Aplicativo Microsoft Excel VBA com Saberexcel

Retorna os formatos de data e hora
Saberexcel - dicas microsoft excel vba macros

Estas funções e declarações do aplicativo microsoft excel vba, retornam os formatos de data hora

Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" _
(ByVal Locale As Long, ByVal LCType As Long, _
ByVal lpLCData As String, ByVal cchData As Long) As Long

Sub testando_formatos_dia_hora()
MsgBox DateCourte, vbInformation, "Saberexcel - site das macros"
MsgBox DateLongue, vbInformation, "Saberexcel - site das macros"
MsgBox FormatoHorario, vbInformation, "Saberexcel - site das macros"
End Sub

Function DateCourte()
Dim tmp$
With Application
tmp = .Substitute(GetParam(&H1F), "d", .International(xlDayCode))
tmp = .Substitute(tmp, "m", .International(xlMonthCode))
tmp = .Substitute(tmp, "y", .International(xlYearCode))
End With
DateCourte = tmp
End Function

Function DateLongue()
Dim tmp$
With Application
tmp = .Substitute(GetParam(&H20), "d", .International(xlDayCode))
tmp = .Substitute(tmp, "m", .International(xlMonthCode))
tmp = .Substitute(tmp, "y", .International(xlYearCode))
End With
DateLongue = tmp
End Function

Function FormatoHorario()
Dim tmp$
With Application
tmp = .Substitute(GetParam(&H1003), "h", .International(xlHourCode))
tmp = .Substitute(tmp, "m", .International(xlMinuteCode))
tmp = .Substitute(tmp, "s", .International(xlSecondCode))
End With
FormatoHorario = tmp
End Function

Private Function GetParam(LocalParam As Long) As String
Dim buf As String
buf = Space$(255)
GetLocaleInfo 0, LocalParam, buf, Len(buf)
GetParam = Application.Trim$(Mid$(buf, 1))
End Function

Function SepDec()
SepDec = Application.International(xlDecimalSeparator)
End Function

Function SepMil()
SepMil = Application.International(xlThousandsSeparator)
End Function

Faça o download do exemplo de planilha microsft excel vba