VBA: checando as propriedades dos arquivos com WMI

Usando a classe WMI Win32_Directory podemos verificar várias propriedades do arquivo: Especificamente, você pode verificar
■ a data que um arquivo foi acessado pela última vez.
■ a data que o arquivo foi criado.
■ a extensão do arquivo e o nome (sem ter que analisar seqüências de caracteres).
■ se um arquivo é gravável.

Eu sei que você pode fazer a maior parte ou todas essas coisas com as APIs do Windows, mas eu acho esse método mais fácil. Primeiro, precisamos acessar o WMI.
Fazemos isso usando a seguinte função:

Function GetFileInfo(fileName As String) As String()
 ' <a href="http://msdn.microsoft.com/en-us/library/aa394130(VS.85).aspx">http://msdn.microsoft.com/en-us/library/aa394130(VS.85).aspx</a>
 Dim objWMI As Object
 Dim colFiles As Object
 Dim objFile As Object
 Dim vtemp() As String

Const NUMBER_OF_PROPERTIES As Long = 11

ReDim vtemp(1, 1 To NUMBER_OF_PROPERTIES)

Set objWMI = GetAnotherWMIService

Set colFiles = objWMI.ExecQuery _
 ("Select * from CIM_DataFile where Name = " & "'" & fileName & "'")

For Each objFile In colFiles
 With objFile
 vtemp(1, 1) = .CreationDate
 vtemp(1, 2) = .Extension
 vtemp(1, 3) = .fileName
 vtemp(1, 4) = .FileSize
 vtemp(1, 5) = .FileType
 vtemp(1, 6) = IIf(Len(.InUseCount & vbNullString) = 0, 0, .InUseCount)
 vtemp(1, 7) = .LastAccessed
 vtemp(1, 8 ) = .LastModified
 vtemp(1, 9) = .Path
 vtemp(1, 10) = .Readable
 vtemp(1, 11) = .Writeable
 End With
 Next objFile

GetFileInfo = vtemp

End Function

Usando a função:

Sub TestDataFileQuery()

Dim str As String
 Dim varr() As String

str = "C:\\Users\\Rodrigo\\Teste.txt"

varr = GetFileInfo(str)

Debug.Print "Este arquivo é regravavel? Resposta: " & varr(11)

End Sub

Usando WMI através do VBA

Usando WMI podemos verificar as informações da conta do computador local. Aqui usamos o Win32_Account classe WMI para percorrer as propriedades disponíveis da classe.

Ajuda do  MSDN:

The Win32_Account abstract WMI class contains information about user accounts and group accounts known to the computer system running Windows. User or group names recognized by a Windows NT domain are descendants (or members) of this class.

A função a seguir vai pegar todas as propriedades da classe Win32_Account usando WQL.

Sub GetAccontInfo()

Dim objWMI As Object
Dim accounts As Object
Dim account As Object

  Set objWMI = GetWMIService

  Set accounts = objWMI.ExecQuery("Select * from Win32_Account")

  For Each account In accounts
    Debug.Print account.Caption
    Debug.Print account.Description
    Debug.Print account.Domain
    Debug.Print account.InstallDate
    Debug.Print account.LocalAccount
    Debug.Print account.Name
    Debug.Print account.SID
    Debug.Print account.SIDType
    Debug.Print account.Status
  Next account

End Sub

Function GetWMIService() As Object
' http://msdn.microsoft.com/en-us/library/aa394586(VS.85).aspx
Dim strComputer As String

  strComputer = "."

  Set GetWMIService = GetObject("winmgmts:" _
                              & "{impersonationLevel=impersonate}!\\" _
                              & strComputer & "\root\cimv2")
End Function

Como usar o ADO com dados do Excel

Este artigo descreve o uso de ActiveX Data Objects (ADO) com planilhas do Microsoft Excel como uma fonte de dados. O artigo também realça os problemas de sintaxe e limitações específicas para o Excel.
As linhas e colunas de uma planilha do Microsoft Excel perto semelhante as linhas e colunas de uma tabela de banco de dados. Desde que os usuários tenha em mente que o Microsoft Excel não é um sistema de gerenciamento de banco de dados relacional e reconhecem as limitações que este fato impõe, geralmente faz sentido para aproveitar o Excel e suas ferramentas para armazenar e analisar dados.

Conectar-se ao Excel com o ADO
O provedor Jet requer apenas duas partes de informação para se conectar a uma fonte de dados do Excel: o caminho, incluindo o nome do arquivo e a versão de arquivo do Excel. Segue um exemplo de conexão:

Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
With cn
.Provider = “Microsoft.Jet.OLEDB.4.0″
.ConnectionString = “Data Source=C:\Pasta1.xls;” & _
“Extended Properties=Excel 8.0;”
.Open
End With

Algumas observações:
É necessário usar o Jet 4.0 Provider; o Jet 3.51 Provider não da suporte aos drivers ISAM do Jet.
Em Extended Properties use a tabela abaixo:

Versão do Excel Extended Properties
Excel 95 Excel 5.0
Excel 97 Excel 8.0
Excel 2000 Excel 9.0
Excel 2002 (XP) Excel 10.0

Nota: Por algum motivo misterioso muitas vezes é necessário usar a versão do Excel como 97, mesmo em versões superiores.
Títulos de coluna : por padrão, presume que a primeira linha da sua fonte de dados do Excel contém títulos de colunas que podem ser usados como nomes de campo. Se isso não for o caso, você deve ativar essa configuração de Desativar ou a primeira linha de dados “desaparece”. Para definir essa opção use opção HDR na seqüência de conexão. O padrão, que não precisa ser especificado, é HDR = Yes . Se você não tem títulos de coluna, você precisará especificar HDR = No. Exemplo:

Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
With cn
.Provider = “Microsoft.Jet.OLEDB.4.0″
.ConnectionString = “Data Source=C:\Pasta1.xls;” & _
“Extended Properties=Excel 8.0; HDR=No;”
.Open
End With

Para especificar a área de retorno você tem duas opções: a planilha toda ou uma área nomeada.
1. Para usar a planilha toda crie uma consulta nesse formato:
SELECT * FROM [Plan1$] ou SELECT * FROM ‘Plan1$’
Se o sinal de cifrão você recebera uma mensagem de erro.

2. Para usar uma área nomeada simplesmente use :
SELECT CPF, Nome FROM Area_Dados;

Mas não se esqueça de criar a região nomeada na planilha alvo, uma desvantagem desse método é não poder cadastrar novos registros.

Espaços desaparecem no VBA (Excel 2010)

Para aqueles que tem o Visual Studio 2010 Ultimate e ao tentar usar o Excel VBA perceberam que ao dar espaços entre as palavras eles desaparecem isso não é uma falha do Excel, mas sim do ‘Load Test Report’ um add-in do Visual Studio, para resolver esse problema até o momento a solução é a desativação do add-in, para isso siga os passos:

1.Clique em no botão Microsoft Office e em Opções;

2.Clique em Add-Ins;

3. Na caixa de seleção escolha COM Add-ins, e em exibir depois é só desativar o add-in.

Assim que tiver uma solução melhor posto aqui.

Gravando log no Visualizador de Eventos do Windows – Parte 2

Property Get Source() As String

    Source = zsSource

End Property

 

Property Let Source(Value As String)

    zsSource = Value

End Property

 

 

‘—————————————————————————————

‘ Procedure  : Log

‘ Data       : 24/02/2010

‘ Programador: Rodrigo

‘ Contato    : thabis.wired@hotmail.com

‘ Descrição  : Efetua a gravação no Log

‘—————————————————————————————

‘

Function Log(ByVal sTitle As String, ByVal sMessage As String, ByVal eLogType As eevLogType) As Boolean

    Dim lLenMessage As Long

    Dim lhwndEventLog As Long

 

    On Error GoTo Log_Error

 

    lhwndEventLog = RegisterEventSource("", zsSource)

 

    lLenMessage = Len(sTitle) + 1

 

    ‘Escreve o evento no log de eventos do aplicativo

    If ReportEvent(lhwndEventLog, eLogType, 0, 1, ByVal 0&, 1, 0, sMessage, ByVal 0&) = 0 Then

        ‘Falha

        Log = False

    Else

        ‘Sucesso

        Log = True

    End If

 

    If lhwndEventLog Then

        DeregisterEventSource(lhwndEventLog)

    End If

 

    Exit Function

Log_Error:

    MsgBox("Erro: " & Err.Number & vbNewLine & "Procedure Log localizado em eventLogWrite, na linha " & Erl, vbCritical, Err.Source)

End Function

 

Private Sub Class_Initialize()

    ‘sempre coloque um nome significativo no seu projeto VBA

    zsSource = Application.VBE.ActiveVBProject.Name

End Sub

 

Com isso concluído o resto é mamão com açúcar. Em um modulo ou formulário, ou até mesmo uma classe de usa escolha instancie a classe e faça um teste como o modelo abaixo:

Sub TestaGravaLog()

    Dim logEventos As eventLogWrite

    logEventos = New eventLogWrite

 

    logEventos.Source = "Projeto de Teste"

    logEventos.Log("Teste de Gravação", "Coloque aqui a mensagem de erro.", EVENTLOG_ERROR_TYPE)

End Sub

A função Log retorna um booleano TRUE se a gravação foi bem sucedida, nesse caso não validei o retorno. Se tudo correu bem você deve encontrar algo parecido com isso em seu Visualizador de Eventos:

Se não quiser ter o “trabalho” de copiar e colar o código da classe pode baixá-la aqui. Espero que seja útil para vocês, até a próxima.

Gravando log no Visualizador de Eventos do Windows – Parte 1

“… No Windows, evento é uma ocorrência significativa no sistema ou em um programa e que exige que os usuários sejam notificados ou que uma entrada seja adicionada a um log. O serviço Log de eventos registra eventos de aplicativo, segurança e sistema no Visualizar eventos. Com os logs de evento no Visualizar eventos, é possível obter informações sobre o hardware, o software, os componentes de sistema e os eventos do monitor de segurança em um computador remoto ou local. Os logs de evento podem ajudar a identificar e diagnosticar a origem dos problemas de sistema atuais ou ainda prevê-los.”
Fonte: http://support.microsoft.com/kb/308427/pt-br

 

Sempre considerei um parte interessante do sistema um log de erro, embora tenha hoje minhas próprias rotinas a alguns anos houve uma necessidade de gravar esses eventos no log de eventos do Windows (disponível depois da versão 2000), nessa primeira parte do artigo vou ensinar como gravar as informações nesse log, nos próximos post’s faremos a leitura desses dados e a exclusão.

Vamos começar criando uma classe chamada eventLogWrite essa classe ira armazenar os códigos de escrita, pode fazer em módulo normal? Sinta se a vontade, mas recomendo o uso de classes.

Nessa classe coloque o código abaixo:

‘———————————————————————’ Modulo     : eventLogWrite

‘ Data       : 24/02/2010

‘ Programador: Rodrigo

‘ Contato    : thabis.wired@hotmail.com

‘ Descrição  : Responsavel pela gravação dos eventos no log do Windows

‘———————————————————————Option Explicit

 

Private zsSource As String

Private Declare Function RegisterEventSource Lib "advapi32.dll" Alias "RegisterEventSourceA" (ByVal lpUNCServerName As String, ByVal lpSourceName As String) As Long

Private Declare Function DeregisterEventSource Lib "advapi32.dll" (ByVal hEventLog As Long) As Long

Private Declare Function ReportEvent Lib "advapi32.dll" Alias "ReportEventA" (ByVal hEventLog As Long, ByVal wType As Long, ByVal wCategory As Long, ByVal dwEventID As Long, ByVal lpUserSid As Any, ByVal wNumStrings As Long, ByVal dwDataSize As Long, ByVal lpStrings As String, ByVal lpRawData As Any) As Long

 

Private Declare Function GetLastError Lib "kernel32" () As Long

 

Private Declare Function OpenEventLog Lib "advapi32.dll" Alias "OpenEventLogA" (ByVal lpUNCServerName As String, ByVal lpSourceName As String) As Long

Private Declare Function CloseEventLog Lib "advapi32.dll" (ByVal hEventLog As Long) As Long

Private Declare Function BackupEventLog Lib "advapi32.dll" Alias "BackupEventLogA" (ByVal hEventLog As Long, ByVal lpBackupFileName As String) As Long

Private Declare Function ClearEventLog Lib "advapi32.dll" Alias "ClearEventLogA" (ByVal hEventLog As Long, ByVal lpBackupFileName As String) As Long

Private Declare Function GetNumberOfEventLogRecords Lib "advapi32.dll" (ByVal hEventLog As Long, ByVal NumberOfRecords As Long) As Long

Private Declare Function GetOldestEventLogRecord Lib "advapi32.dll" (ByVal hEventLog As Long, ByVal OldestRecord As Long) As Long

 

Private Type EVENTLOGRECORD

   Length As Long

   Reserved As Long

   RecordNumber As Long

   TimeGenerated As Long

   TimeWritten As Long

   EventID As Long

   EventType As Integer

   NumStrings As Integer

   EventCategory As Integer

   ReservedFlags As Integer

   ClosingRecordNumber As Long

   StringOffset As Long

   UserSidLength As Long

   UserSidOffset As Long

   DataLength As Long

   DataOffset As Long

End Type

 

Public Enum eevLogType

    EVENTLOG_SUCCESS = 0

    EVENTLOG_ERROR_TYPE = 1

    EVENTLOG_WARNING_TYPE = 2

    EVENTLOG_INFORMATION_TYPE = 4

    EVENTLOG_AUDIT_SUCCESS = 8

    EVENTLOG_AUDIT_FAILURE = 10

End Enum

Usando o Internet Explorer apartir do VBA

Sei que ando sumido daqui nos últimos tempos, mas esta muito corrido, espero que com a proximidade do carnaval as coisas se acalmem um pouco, ontem a noite depois de terminar uma etapa de um  projeto e para matar o tempo comecei a fuçar nas referencias  que o VBA possui e encontrei a do Internet Explorer, após fuçar um pouco montei esse exemplo que permite abrir um site e manipular o IE (ocultando e exibindo barras e menus). Permitindo que através de sua aplicação você possa acessar sites através de janelas mais configuráveis. Download da Planilha

Status da bateria do notebook pelo VBA

La estava eu em casa no sábado à noite, sem muito que fazer e comecei a fuçar no VBA com mais alguns livros que eu tenho e acabei montando essa planilha que estou disponibilizando com esse post, ela verifica o status da bateria de notebook ou nobrek alem da porcentagem de carga ela exibe o tempo de vida útil e total da bateria (em alguns modelos essa funcionalidade não esta disponível), exibe se a bateria esta carregando e o perfil de energia.

É um exemplo simples que demonstra todo poder e flexibilidade do VBA. Download

Projeto Desenvolvido para Novo Nordisk

Há algum tempo venho querendo fazer esse post, mas sempre me falta tempo, foi de um projeto que desenvolvi para os Laboratórios Novo Nordisk, o projeto foi todo desenvolvido em Excel VBA e tinha como objetivo controlar a informações de cadastros e agrupamentos de médicos e eventos relacionados, foi um dos poucos projetos ao qual me apeguei, ainda tenho um leque de possibilidades de melhora para esse projeto, quem sabe no futuro as realizo.

Tela de Login do Sistema

Tela Inicial da planilha

Chamar qualquer tela do Painel de Controle através do VBA

Revirando minhas coisas atrás de algum artigo que pudesse me ajudar com um problema de rede acabei encontrando esse velho artigo, 
que na verdade são exemplos de código que ensinam como chamar telas do painel de controle diretamente de sua aplicação VBA,
há alguns anos usei algumas dessas chamadas em um aplicativo de expedição. O Artigo foi escrito originalmente por 3D Man® do
antigo site Silício. Espero que ajude a vocês como me ajudou:

Para chamar qualquer tela do Painel de Controle não se usa necessariamente uma API, mas sim se executa o programa rundll32.exe. 
De acordo com os parâmetros cada tela é chamada. Veja as chamadas das principais telas: 

‘Para chamar a tela principal do Painel de Controle:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL", vbNormalFocus)

‘Para chamar a tela Adicionar ou Remover Programas:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1", vbNormalFocus)

‘Para chamar a tela Adicionar ou Remover Programas, na aba
‘Instalao do Windows:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,2", vbNormalFocus)

‘Para chamar a tela Adicionar ou Remover Programas, na aba
‘Disco de Inicializao:
Call Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,3", vbNormalFocus)

‘Para chamar a tela Vdeo, na aba Segundo Plano:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0", vbNormalFocus)

‘Para chamar a tela Vdeo, na aba Proteo de Tela:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,1", vbNormalFocus)

‘Para chamar a tela Vdeo, na aba Aparncia:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,2", vbNormalFocus)

‘Para chamar a tela Vdeo, na aba Configurao:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3", vbNormalFocus)

‘Para chamar a tela Configuraes Regionais, na aba
‘Configuraes Regionais:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,0", vbNormalFocus)

‘Para chamar a tela Configuraes Regionais, na aba
‘Nmero:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,1", vbNormalFocus)

‘Para chamar a tela Configuraes Regionais, na aba
‘Moeda:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,2", vbNormalFocus)

‘Para chamar a tela Configuraes Regionais, na aba’Hora:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,3", vbNormalFocus)

‘Para chamar a tela Configuraes Regionais, na aba’Data:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,4", vbNormalFocus)

‘Para chamar a tela Joystick:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL joy.cpl", vbNormalFocus)

‘Para chamar a tela Mouse:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @0", vbNormalFocus)

‘Para chamar a tela Teclado:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @1", vbNormalFocus)

‘Para chamar a tela Impressoras:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @2", vbNormalFocus)

‘Para chamar a tela Fontes:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @3", vbNormalFocus)

‘Para chamar a tela Mail e Fax:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL mlcfg32.cpl", vbNormalFocus)

‘Para chamar a tela Multimdia, na aba Audio:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,0", vbNormalFocus)

‘Para chamar a tela Multimdia, na aba Vdeo:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,1", vbNormalFocus)

‘Para chamar a tela Multimdia, na aba MIDI:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,2", vbNormalFocus)

‘Para chamar a tela Multimdia, na aba Msica de CD:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,3", vbNormalFocus)

‘Para chamar a tela Multimdia, na aba Dispositivos:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,4", vbNormalFocus)

‘Para chamar a tela Som:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl @1", vbNormalFocus)

‘Para chamar a tela Modem:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL modem.cpl", vbNormalFocus)

‘Para chamar a tela Rede:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL netcpl.cpl", vbNormalFocus)

‘Para chamar a tela Senhas:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL password.cpl", vbNormalFocus)

‘Para chamar a tela Sistema, na aba Geral:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,0", vbNormalFocus)

‘Para chamar a tela Sistema, na aba Gerenciador’de Dispositivos:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,1", vbNormalFocus)

‘Para chamar a tela Sistema, na aba Perfis de

Hardware:
Call Shell("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,2", vbNormalFocus)

‘Para chamar a tela Sistema, na aba Performance:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,3", vbNormalFocus)

‘Para chamar a tela Opes de Acessibilidade, na aba’Teclado:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL access.cpl,,1", vbNormalFocus)

‘Para chamar a tela Opes de Acessibilidade, na aba’Som:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL access.cpl,,2", vbNormalFocus)

‘Para chamar a tela Opes de Acessibilidade, na aba’Vdeo:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL access.cpl,,3", vbNormalFocus)

‘Para chamar a tela Opções de Acessibilidade, na aba’Mouse:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL access.cpl,,4", vbNormalFocus)

‘Para chamar a tela Opes de Acessibilidade, na aba’Geral:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL access.cpl,,5", vbNormalFocus)

‘Para chamar a tela do Assistente (Adicionar novo’Hardware):

Call Shell("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl @1", vbNormalFocus)

‘Para chamar a tela Data e Hora:

Call Shell("rundll32.exe shell32.dll,Control_RunDLL timedate.cpl", vbNormalFocus)

‘Para chamar a tela DiskCopy:

Call Shell("rundll32 diskcopy.dll,DiskCopyRunDll", vbNormalFocus)