how to get folder's created time in Excel?
I know
FileDateTime(FileOrFoldername)
can retrive a time, but that is the "created or last modified date"; also
Set oFS = CreateObject("Scripting.FileSystemObject")
FileCreatedAt = oFS.GetFile(PathWithFilename).DateCreated
could retrieve the file created time, but this does not work for a folder.
Use following sub to get folder created date and time
Sub DirDate()
Dim fso As New Scripting.FileSystemObject
Dim fld As Scripting.Folder
Set fld = fso.GetFolder("c:\windows")
MsgBox fld.DateCreated
End Sub
You have to active the Microsoft Scripting Runtime in references. See below screenshot.
This should help you:
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(PathName)
ShowDateCreated = f.DateCreated
https://msdn.microsoft.com/en-us/library/1c87day3(v=vs.84).aspx
Related
I am trying to write some macros in both Excel and Outlook that in the end will automatically unzip and open a CSV, process the data, and sends it where it needs to go when a new email arrives in a specific folder. I have everything worked out on the Excel side but I am having difficulties with Outlook. The below code unzips the file. How would i go about opening the unzipped file and triggering an Excel macro (which is always open in another workbook)?
Another issue I am running into: this code only seems to work when i actually open the target email in it's own window.
Public Sub OpenZippedSheet()
Dim objMail As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment
Dim objShell As Object
Dim objFileSystem As Object
Dim strTempFolder As String
Dim strFilePath As String
Dim strFileName As String
Set objMail = Outlook.Application.ActiveInspector.CurrentItem
Set objAttachments = objMail.Attachments
'Save & Unzip the zip file in local drive
Set objShell = CreateObject("Shell.Application")
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
strTempFolder = objFileSystem.GetSpecialFolder(2).Path & "\Temp" & Format(Now, "yyyy-mm-dd-hh-mm-ss")
MkDir (strTempFolder)
For Each objAttachment In objAttachments
If Right(objAttachment.FileName, 3) = "zip" Then
strFilePath = strTempFolder & "\" & objAttachment.FileName
objAttachment.SaveAsFile (strFilePath)
objShell.NameSpace((strTempFolder)).CopyHere objShell.NameSpace((strFilePath)).Items
End If
Next
End Sub
I'm assuming I would do some sort of object.open but I don't know what the syntax would be to get it to actually open in Excel. And then is there a way to trigger an Excel macro from Outlook?
Thanks so much in advance!
this code only seems to work when i actually open the target email in it's own window.
That is because you rely on the ActiveInspector window. If you want to handle items selected in the Explorer windows you need to check the Selection object (see the corresponding property).
To open an Excel file you can:
Use the Shell.ShellExecute method. This method is equivalent to launching one of the commands associated with a file's shortcut menu. Each command is represented by a verb string. The set of supported verbs varies from file to file. The most commonly supported verb is "open", which is also usually the default verb. Other verbs might be supported by only certain types of files.
Automate Excel from your VBA macro to do the required actions. See How to automate Microsoft Excel from Visual Basic for more information.
To run your VBA macro code from other applications you can use the Application.Run method. Read more about that in the How do I use Application.Run in Excel article.
Application.Run "'" & TestWkbk.Name & "'!MacroNameHere", "parm1", "parm2"
Something like this (untested so may need some fixes):
'Note - any paths passed to objShell should be
' passed as *Variants*, not Strings
Dim oXL As Object, wbCSV As Object, fileNameInZip As Variant
Set objShell = CreateObject("Shell.Application")
For Each objAttachment In objAttachments
If Right(objAttachment.Filename, 3) = "zip" Then
strFilePath = strTempFolder & "\" & objAttachment.Filename
objAttachment.SaveAsFile strFilePath
Set oNS = oApp.Namespace(strFilePath)
For Each fileNameInZip In oNS.items 'loop over the files in the zip
Debug.Print fileNameInZip
If LCase(fileNameInZip) Like "*.csv" Then 'csv file?
'extract the file
objShell.Namespace(strTempFolder).copyhere oNS.items.Item(CStr(fileNameInZip))
If oXL Is Nothing Then Set oXL = GetObject(, "Excel.Application") 'assumes excel is running
Set wbCSV = oXL.Workbooks.Open(strTempFolder & "\" & fileNameInZip)
oXL.Run "'YourMacroFile.xlsm'!YourMacroName" 'run the macro
'clean up stuff...
End If 'is a csv file
Next 'file in zip
End If 'attachment is a zip file
Next 'attachment
I am trying to make a macro that opens all .xlsm files in a folder:
C:\Users\iborrego\Desktop\zfichasmacro\Fichas excel\
And copy some cells (from different worksheets).
Information from each file should be assigned only to one row as I will use the first row for titles (ID Nº; Date of visit etc …)
And one row for each file in the folder.
I would really appreciate if you could help me write the macro and tell me how it works as I am not an IT.
I did not understand the second part of your question, but here is a code which opens every xlsm in your given folder:
Sub Xlsmopener()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Users\iborrego\Desktop\zfichasmacro\Fichas excel")
i = 1
For Each objFile In objFolder.Files
If objFSO.GetExtensionName(objFile.Path) = "xlsm" Then
Workbooks.Open (objFile.Path)
End If
i = i + 1
Next objFile
End Sub
I have a code that open access from excel:
Dim objShell As Object
Set objShell = CreateObject("Shell.Application")
objShell.Open "\\acrtnd\share$\PUBLIC\!tools\preportDST.accdb"
Set objShell = Nothing
I would like to little automatized that and add to it code that will paste value in to field in access and run macro in access that start calculation, but I have not knowidge about manageing other office parts from inside excel. The text box name is "txt_PasteField" and VBA macro in access is name "run_calculation", I try something like this below but objShell do not allow such actions.
Dim objShell As Object
Set objShell = CreateObject("Shell.Application")
objShell.Open "\\acrtnd\share$\PUBLIC\!tools\preportDST.accdb"
objShell.txt_PasteField.Value = Sheets("dashboard").Cells(5, 1).Value
call objShell.run_calculation
Set objShell = Nothing
Can someone provide be way to do that or navigate me to needed command?
Thanks in advance for helping.
I'll try to help you, but I'm still a little unclear on the details. Since a text field has to be either on a form or a report, you have to open it first. Also, if you want to influence the Access application after opening it, you will need to use OLE automation.
Dim appAccess As Object
Set appAccess = CreateObject("Access.Application")
With appAccess
.OpenCurrentDatabase "\\acrtnd\share$\PUBLIC\!tools\preportDST.accdb"
.UserControl = True
.DoCmd.OpenForm "MyForm"
.Forms!MyForm.txt_PasteField.Value = Sheets("dashboard").Cells(5, 1).Value
.Run "run_calculation"
End With
I am trying to create worksheets depending on the number of files present in the current folder.This is my current folder:
Folder
CalculationSheet.xls
Data1.xls
Data2.xls
Data3.xls
So I'll be searching for "/*.xls" using the count.
I need to create worksheets in CalculationSheet.xls as I am new to macro. Please help me on this.
Use a code something like this:
Sub GetDataFiles()
Dim strFolder As String
Dim fso As Object
Dim fileTemp As Object
Dim ws As Worksheet
' Open library of Microsoft Scripting Runtime
Set fso = CreateObject("Scripting.FileSystemObject")
strFolder = ActiveWorkbook.Path
If (fso.FolderExists(strFolder)) Then
' Check All files in the folder
For Each fileTemp In fso.GetFolder(strFolder).Files
If fileTemp.Name Like "Data*.xls" Then
Set ws = ActiveWorkbook.Sheets.Add
ws.Name = fileTemp.Name
End If
Next
End If
End Sub
I'm using VBA in Excel to loop through files on a sharepoint site and open all Excel files.
The code crashes Excel the first time I run it, however, if I then reopen it it works fine.
Are there any known issues around this?
Thanks.
Edit: Here is the code:
Sub Refresh()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
Dim fso As FileSystemObject
Dim fldr As Folder
Dim f As File
Dim wb As Workbook
Set fso = New FileSystemObject
Set fldr = fso.GetFolder(SharePointSite)
For Each f In fldr.Files
Set wb = Workbooks.Open(SharePointURL & f.Name)
Next f
Set wb = Nothing
Set fldr = Nothing
Set fso = Nothing
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Instead of mapping the document library to a drive letter try using the WebDAV address to access the library in your code. This way if the macro is distributed no one will be dependent upon having the "Z:" drive being mapped to a specific location
Set your FilePath variable equal to a string like this (use #SSL for HTTPS sites):
\\sharepoint.site.com#SSL\DavWWWRoot\site1\usersite\Book2\Shared%20Documents
If you are going to access the text file directly then set it up like this:
\\sharepoint.site.com#SSL\DavWWWRoot\site1\usersite\Book2\Shared%20Documents
\Test_Text1.txt
Take a look at this blog post for a full explanation on retrieving the WebDAV path.