Re: Data de atualização por Mauro Coutinho » 04 Out 2010, 22:32 A rotina abaixo, retorna a Data de Criação, Acesso e Modificação de um Arquivo em um msgbox, você pode definir um arquivo especifico ou Abrir a cx de dialogo para selecionar um.

Escola Saberexcel VBA Estudos - O site de quem precisa aprender Macros MS Excel VBA

Esse Macro do Aplicativo Microsoft Excel VBA, retorna as datas da propriedade do objeto planilha, data de criação, data do último acesso e também a data da última modificação:

Sub sbx_visualizar_datas_acesso_arquivo_modificacao()
Dim sb, s, b

'especificando o caminho do arquivo
vArquivo = "C:\Users\SaberExcel\Desktop\Principal.xls"

'caso queira abrir a caixa de diálogo para escolher o arquivo
'vArquivo = Application.GetOpenFilename

Set sb = CreateObject("Scripting.FileSystemObject")
Set s = sb.GetFile(vArquivo)
b = UCase(vArquivo) & vbCrLf
b = b & "Criado em......... : " & s.DateCreated & vbCrLf
b = b & "Último Acesso..... : " & s.DateLastAccessed & vbCrLf
b = b & "Última Modificação : " & s.DateLastModified & vbCrLf & _
" ------------------------------" & _
vbCrLf & "Escola Saberexcel VBA Estudos®" & vbCrLf & _
" ------------------------------"
MsgBox b, vbInformation, "Saberexcel - acessos ao arquivo -" & vArquivo
'retornando dados para folha de planilha
'alinhamento da mensagem na célula(A1)
With [a1]
.Value = b: [a1].ClearFormats 'limpando formatos original
.Font.Name = "Consolas" 'inserindo fonte
.Font.Size = 8 'inserindo tamanho da fonte
.HorizontalAlignment = xlGeneral 'alinhando texto
.VerticalAlignment = xlTop 'alinhando texto acima
.WrapText = True 'Retorna ou define um valor Variant que indica se o excel faz retorno automático do texto no objeto.
End With
Columns("A").AutoFit
End Sub

Sub sbx_limpar()
[a1].ClearContents
End Sub


Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.

Este exemplo Microsoft Excel VBA, abre um arquivo txt e importa os dados para coluna(A) de uma determinada folha de Planilha. observe que no arquivo texto onde for usado a virgula para separação de palavras, é inserido automaticamente uma quebra de linha.
Observe que a macro busca os dados em um arquivo texto no Path(Diretório) Ativo, e já inseri um arquivo texto no path do exemplo chamado Dados.txt

Sub Abrindo_um_arquivo_txt()
Dim Relacao, Numero, Localizacao

Saber1.Columns(1).ClearContents

Localizacao = 2

Open ThisWorkbook.Path & "\Dados.txt" For Input As #1 ' Abre o arquivo para entrada dos dados.

Do While Not EOF(1) ' EOF(1)>>Faz o loop ate o fim do arquivo.
Input #1, Relacao ' memoriza os dados para a variável.
Saber1.Cells(Localizacao, 1) = Relacao '
Localizacao = Localizacao + 1
Loop

Close #1 ' Fecha o arquivo txt
Saber1.[A1].Value = "ABRINDO E EXTRAINDO DADOS DE UM ARQUIVO TXT"
End Sub

Sub LIMPAR()
[A1:A30].ClearContents
End Sub



Aprenda Microsoft Excel VBA ---(SaberExcel)-- o site das macros
Aprenda sozinho, em casa, com seu esforço, com baixo custo.
Tudo que voce puder imaginar em excel vba, poderá encontrar neste site.

Saberexcel - o Site das Macros
Essa macro do Aplicativo Microsoft Excel VBA, contam a quantidade de arquivos existentes em determinado diretorio, observem que a macro esta referenciando ao caminho (Path) 'diretorio' contido na célula(A1), então para que funcione corretamente, forneça o caminho correto. Espero tê-los ajudado! - Fiquem com Deus - Expedito Marcondes.


Sub Quanidades_arquivos_xls_existentes_diretorio()

With Application.FileSearch
.NewSearch
.LookIn = Range("A1").Value ' ou C:\Documents and Settings\Usuario\
.Filename = "*.xls"
.Execute
'MsgBox .FoundFiles.Count
End With
If Application.FileSearch.FoundFiles.Count > 1 Then
MsgBox "Existem " & Application.FileSearch.FoundFiles.Count & " Arquivos.xls", vbInformation, "Saberexcel.com"
Range("a2") = "Existem " & Application.FileSearch.FoundFiles.Count & " Arquivos.xls"
Else
MsgBox "Existe " & Application.FileSearch.FoundFiles.Count & " Arquivos.xls", vbInformation, "Saberexcel.com"
Range("a2") = "Existe " & Application.FileSearch.FoundFiles.Count & " Arquivo.xls"
End If

End Sub

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA com SaberExcel

Saberexcel - o site das macros

Macros do Aplicativo Microsoft Excel VBA, lista os arquivos de um determinado (escolhido) diretório

Sub Testar_Lista_Arquivos_nas_pastas()
Dim RootFolder$

'Diretório à scanear
RootFolder = Localiza_Dir

If RootFolder = "" Then Exit Sub
' criando novo Workbook para receber a lista
Workbooks.Add
' Adicionando Cabeçalho

With Range("A1")
.Formula = "Contendo os Diretórios : " & RootFolder
.Font.Bold = True
.Font.Size = 12
End With

Range("A3").Formula = "Caminho: "
Range("B3").Formula = "Nome : "
Range("C3").Formula = "Data Criação : "
Range("D3").Formula = "Data último Accesso : "
Range("E3").Formula = "Data última Modificação : "

With Range("A3:E3")
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True

End With

' list all files included subfolders

ListFilesInFolder RootFolder, True
Columns("A:H").AutoFit

End Sub

'
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True

Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)

r = Range("A65536").End(xlUp).Row + 1

For Each FileItem In SourceFolder.Files
'display file properties

Cells(r, 1).Formula = FileItem.ParentFolder
Cells(r, 2).Formula = FileItem.Name
Cells(r, 3).Formula = FileItem.DateCreated
Cells(r, 3).NumberFormatLocal = "dd / mm / aaaa"
Cells(r, 4).Formula = FileItem.DateLastAccessed
Cells(r, 5).Formula = FileItem.DateLastModified
Cells(r, 5).NumberFormatLocal = "dd / mm / aaaa"
' next row number

r = r + 1
Next FileItem

If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If

Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing

ActiveWorkbook.Saved = True

End Sub

Private Function Localiza_Dir()
Dim objShell, objFolder, chemin, SecuriteSlash

Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Saberexcel - Procurar por um Diretório", &H1&)
On Error Resume Next

chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""

If objFolder.Title = "Bureau" Then
chemin = "C:\Windows\Bureau"
End If

If objFolder.Title = "" Then
chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then
chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If

Localiza_Dir = chemin

End Function

Aprenda Microsoft Excel VBA