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
