Private Sub teste()
Dim ultimo_dia_mes As Date
ultimo_dia_mes = CDate(1 & "/" & Month(Now()) + 1 & "/" & Year(Now())) - 1
If ultimo_dia_mes = Format(Now, "dd/mm/yyyy") Then
MsgBox "ultimo dia"
End If
End Sub
Dim hora_atual As Date
Sub hora()
ThisWorkbook.Sheets("Plan1").Range("A1").Value = Format(Time, "hh:mm:ss")
Call acerta_hora
End Sub
Sub acerta_hora()
hora_atual = Now + TimeValue("00:00:01")
Application.OnTime hora_atual, "hora"
End Sub
Sub parar()
Application.OnTime EarliestTime:=hora_atual, Procedure:="hora", Schedule:=False
End Sub
Sub Listar_emails_Access()
Dim rst As New ADODB.Recordset
Dim cnn As New ADODB.Connection
Dim contador_itens As Integer
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim itm As Object
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder
cnn.Open "Provider=Microsoft.JET.OLEDB.4.0;" & "Data Source=" & "C:\banco.mdb"
rst.Open "Tabela1", cnn, adOpenKeyset, adLockOptimistic
contador_itens = fld.Items.Count
For Each itm In fld.Items
If itm.Class = olMail Then
rst.AddNew
rst!titulo = itm.Subject
rst!Data = itm.ReceivedTime
rst.Update
End If
Next itm
rst.Close
cnn.Close
MsgBox "Fim"
End Sub
Sub importa_delimitado()
Dim entrada As String 'linha do txt
Dim i As Single 'número de caracteres
Dim linha As Integer
Dim coluna As Integer
Dim texto As String 'texto a ser gravado na célula
Dim ultimo As Boolean 'controle do último caracter da linha
Open "C:\Users\kazu\Desktop\pasta1.csv" For Input As #1
linha = 1
coluna = 1
Do While Not EOF(1)
Line Input #1, entrada
For i = 1 To Len(entrada)
If Mid(entrada, i, 1) = ";" Then
Cells(linha, coluna).Value = texto
coluna = coluna + 1
texto = ""
Else
'Se for o último caracter, grava na célula
If i = Len(entrada) Then
texto = texto & Mid(entrada, i, 1)
Cells(linha, coluna).Value = texto
coluna = coluna + 1
texto = ""
ultimo = True
End If
If Not ultimo Then texto = texto & Mid(entrada, i, 1)
End If
ultimo = False
Next
linha = linha + 1
coluna = 1
Loop
Close #1
End Sub
Option Explicit
Dim texto As String
Sub teste()
texto = " azul "
Debug.Print texto
'Texto alinhado à esquerda dentro da variável
LSet texto = "azul"
Debug.Print texto
'Texto alinhado à direita dentro da variável
RSet texto = "azul"
Debug.Print texto
End Sub
Option Explicit
Sub SQL_Express()
Dim rst As New ADODB.Recordset
Dim cnn As New ADODB.Connection
Dim i As Integer
cnn.Open "Provider=SQLNCLI;Data Source=(local)\SQLEXPRESS;uid=sa;pwd=123;database=northwind"
rst.CursorLocation = adUseClient
rst.Open "SELECT CompanyName FROM customers", cnn, adOpenKeyset, adLockOptimistic
i = 1
Do While Not rst.EOF
Cells(i, 1).Value = rst!CompanyName
i = i + 1
rst.MoveNext
Loop
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
Muitas vezes durante a execução de uma macro, queremos acompanhar o andamento do processo.Option Explicit
Dim i As Integer
Sub status_bar()
For i = 1 To 5000
DoEvents
Cells(i, 1).Value = "Teste"
Application.StatusBar = "Preenchendo célula " & i & " de 5.000"
Next
Application.StatusBar = False
End Sub
Sub ver()
Dim arquivo As String
arquivo = "c:\teste.xls"
Dim cnn As New ADODB.Connection
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;data source = " _
& arquivo & ";Extended Properties=Excel 8.0;"
On Error Resume Next
cnn.Execute "SELECT top 1 * from [planilha1$]"
If Err.Number = 0 Then
MsgBox "Planilha existe"
Else
MsgBox "Planilha não existe"
End If
cnn.Close
Set cnn = Nothing
End Sub
