I am using below code to get the created date of a workbook.
Dim mFile As String
mFile = "C:\User\User.Name\Test\Test.xlsx"
Debug.Print CreateObject("Scripting.FileSystemObject").GetFile(mFile).DateCreated
However to my surprise, this returns the date when the file is created in the directory. If you copy the file to another folder, above will return that time and date it was copied (created).
To actually get the original created date, I tried using BuiltinDocumentProperties method. Something like below:
Dim wb As Workbook
Set wb = Workbooks.Open(mfile) '/* same string as above */
Debug.Print wb.BuiltinDocumentProperties("Creation Date")
Above does return the original date the file was actually created.
Now, I have hundreds of file sitting in a directory that I need to get the original creation date. I can certainly use above and look over the files, but opening and closing all of it from a shared drive takes some time. So I was wondering, if I can get the BuiltinDocumentProperties without opening the file(s) like using the first code above which is a lot faster and easier to manage.
If you somebody can point me to a possible solution, that would be great.
Try something like this. The key is the special DSO object.
Imports Scripting
Private Sub ReadProperties()
Dim pathName As String = "C:\yourpathnamehere"
Dim Fso As FileSystemObject = New Scripting.FileSystemObject
Dim fldr As Folder = Fso.GetFolder(pathName)
Dim objFile As Object = CreateObject("DSOFile.OleDocumentProperties")
Dim ResValue As String = Nothing
For Each f In fldr.Files
Try
objFile.Open(f)
ResValue = objFile.SummaryProperties.DateCreated
' Do stuff here
objFile.Close
Catch ex As Exception
'TextBox1.Text = ex.Message
End Try
Application.DoEvents()
Next
End Sub
Related
I have a macro files with file extension of .DO Files(.DO). I Open a file through vb.net
application and to also open a macro. by using that macro I need to format that word Document. I
tried a lot but no use . I try to Select some area of word file but it will leads to error:
Object reference not set to instance of object
Private sub beginFormatting
ls_inipath = System.Windows.Forms.Application.StartupPath & "\"
ls_Document = GetIniValue("Remove_Pages", "doc_name", txtFileName.Text)
Dim what As Object = Word.WdGoToItem.wdGoToLine
Dim which As Object = Word.WdGoToDirection.wdGoToLast
Dim SelectionOne As Selection
Dim returnValue As Range = SelectionOne.GoTo(what, which, Nothing,
Nothing)
SelectionOne.EndKey(WdUnits.wdStory, WdMovementType.wdMove)
end sub
I need to add text string to all files on a folder, as a footer
For example, on the folder on the path and called C:\mobatchscripts\
I have a random number of txt files, with text.
I want to add a line for example "text" on each of the text files on the folder
I have little knowledge of vba programming, but for what I have read I can use append, but I need something that loop on the files on the folder, and modify them.
So far I tried this:
Sub footer()
Dim FolderPath As String
Dim FileName As String
Dim wb As Excel.Workbook
FolderPath = "C:\mobatchscripts\"
FileName = Dir(FolderPath)
Do While FileName <> ""
Open FileName For Append As #1
Print #1, "test"
Close #1
FileName = Dir
Loop
End Sub
But seems that its not looking into the files, or appending the text.
On the assumption that you're writing to text files (I see "batchscripts" in the path), you need a reference to the Microsoft Scripting Runtime (Within the VBE you'll find it in Tools, References)
Option Explicit
Public Sub AppendTextToFiles(strFolderPath As String, _
strAppendText As String, _
blnAddLine As Boolean)
Dim objFSO As FileSystemObject
Dim fldOutput As Folder
Dim filCurrent As File
Dim txsOutput As TextStream
Set objFSO = New FileSystemObject
If objFSO.FolderExists(strFolderPath) Then
Set fldOutput = objFSO.GetFolder(strFolderPath)
For Each filCurrent In fldOutput.Files
Set txsOutput = filCurrent.OpenAsTextStream(ForAppending)
If blnAddLine Then
txsOutput.WriteLine strAppendText
Else
txsOutput.Write strAppendText
End If
txsOutput.Close
Next
MsgBox "Wrote text to " & fldOutput.Files.Count & " files", vbInformation
Else
MsgBox "Path not found", vbExclamation, "Invalid path"
End If
End Sub
I'd recommend adding error handling as well and possibly a check for the file extension to ensure that you're writing only to those files that you want to.
To add a line it would be called like this:
AppendTextToFiles "C:\mobatchscripts", "Test", True
To just add text to the file - no new line:
AppendTextToFiles "C:\mobatchscripts", "Test", False
Alternatively, forget the params and convert them to constants at the beginning of the proc. Next time I'd recommend working on the wording of your question as it's not really very clear what you're trying to achieve.
This seems so simple and I've had it working multiple times, but something keeps breaking between my Dir call (to iterate through a directory) and opening the current file. Here's the pertinent code:
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
'Start looping through directory
While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceCurrentFile)
What I get with this is a file access error as the Application.Workbooks.Open is trying to open "C:\ExcelWIP\TestSource\\FILENAME" (note extra slash)
However when I take the final slash out of SourceLoc, the results of Dir(SourceLoc) are "" (it doesn't search the directory).
The frustrating thing is that as I've edited the sub in other ways, the functionality of this code has come and gone. I've had it work as-is, and I've had taking the '/' out of the directory path make it work, and at the moment, I just can't get these to work right together.
I've scoured online help and ms articles but nothing seems to point to a reason why this would keep going up and down (without being edited except for when it stops working) and why the format of the directory path will sometimes work with the final '/' and sometimes without.
any ideas?
This would open all .xlxs files in that directory son.
Sub OpenFiles()
Dim SourceCurrentFile As String
Dim FileExtension as String: FileExtension = "*.xlxs"
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
SourceCurrentFile = Dir()
'Start looping through directory
Do While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceLoc &"\"& SourceCurrentFile)
SourceCurrentFile = Dir(FileExtension)
Loop
End Sub
JLILI Aman hit on the answer which was to take the results of Dir() as a string. Using that combined with the path on Application.Open allows for stable behaviors from the code.
New Code:
Dim SourceLoc as String
Dim SourceCurrentFile as String
SourceLoc = "C:\ExcelWIP\TestSource\"
SourceCurrentFile = Dir(SourceLoc)
'Start looping through directory
While (SourceCurrentFile <> "")
Application.Workbooks.Open (SourceLoc & "/" & SourceCurrentFile)
I didn't include the recommended file extension because I'm dealing with xls, xlsx, and xlsm files all in one directory. This code opens all of them.
Warning - this code will set current file to each file in the directory including non-excel files. In my case, I'm only dealing with excel files so that's not a problem.
As to why this happens, it does not appear that Application.Open will accept the full object results of Dir(), so the return of Dir() needs to be a String. I didn't dig deeper into the why of it beyond that.
Consider using VBA's FileSystemObject which includes the folder and file property:
Sub xlFilesOpen()
Dim strPath As String
Dim objFSO As Object, objFolder As Object, xlFile As Object
strPath = "C:\ExcelWIP\TestSource"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)
For Each xlFile In objFolder.Files
If Right(xlFile, 4) = "xlsx" Or Right(xlFile, 3) = "xls" Then
Application.Workbooks.Open (xlFile)
End If
Next xlFile
Set objFSO = Nothing
Set objFolder = Nothing
End Sub
There are a number of similar posts but nothing that does exactly what I want as simply as it needs to be for me to understand
I want to use Access 2007 VBA to open a csv file and replace the column headings row ie:
OldColumn1,OldColumn2
1,2
with
NewColumn1,NewColumn2
1,2
ie without disturbing the rump of data.
Then save and close.
I have tried this code, but it deletes my data:
Sub WriteFile()
Dim OutputFileNum As Integer
Dim PathName As String
PathName = Application.ActiveWorkbook.Path
OutputFileNum = FreeFile
Open PathName & "\Test.csv" For Output Lock Write As #OutputFileNum
Print #OutputFileNum, "NewCol1" & "," & "NewCol2"
Close OutputFileNum
End Sub
Import or link to the .csv so that you have the recordset in your Access 2007 databases.
Write a query with NewColumn[x] as an alias for OldColumn[x].
Write vba code to use TransferText functionality or make a macro to do the same to export your query as a .csv file (overwriting the original csv if you want/need).
Obviously, there are plenty of bonus things you could do to automate and reproduce this concept for any number or types of files. But the above solution should work in an all MS Access environment.
Let me know if you would like details on any of these steps.
Further to my earlier comment, please see the method which uses the Excel reference:
Public Sub EditCsv()
Dim xlApp As Object
dim xlWbk As Object
Dim xlWst As Object
Set xlApp = CreateObject("Excel.Application")
Set xlWbk = xlApp.Workbooks.Open ".../Test.csv" 'Amend this to your needs
Set xlWst = xlWbk.Sheets(1)
'This assumes the columns are at the beginning of the file
xlWst.Range("A1") = "My New Column Name"
xlWst.Range("B1") = "My New Second Column Name"
xlWbk.Close -1 'Close and save the file here
xlApp.Quit
Set xlApp = Nothing
Set xlWbk = Nothing
Set xlWst = Nothing
End Sub
Using VBA. My script moves a file into a directory. If that filename already exists in the target directory, I want the user to be prompted to rename the source file (the one that's being moved) before the move is executed.
Because I want the user to know what other files are in the directory already (so they don't choose the name of another file that's already there), my idea is to open a FileDialog box listing the contents of the directory, so that the user can use the FileDialog box's native renaming capability. Then I'll loop that FileDialog until the source file and target file names are no longer the same.
Here's some sample code:
Sub testMoveFile()
Dim fso As FileSystemObject
Dim file1 As File
Dim file2 As File
Dim dialog As FileDialog
Set fso = New FileSystemObject
fso.CreateFolder "c:\dir1"
fso.CreateFolder "c:\dir2"
fso.CreateTextFile "c:\dir1\test.txt"
fso.CreateTextFile "c:\dir2\test.txt"
Set file1 = fso.GetFile("c:\dir1\test.txt")
Set file2 = fso.GetFile("c:\dir2\test.txt")
Set dialog = Application.FileDialog(msoFileDialogOpen)
While file1.Name = file2.Name
dialog.InitialFileName = fso.GetParentFolderName(file2.Path)
If dialog.Show = 0 Then
Exit Sub
End If
Wend
file1.Move "c:\dir2\" & file1.Name
End Sub
But when I rename file2 and click 'OK', I get an error:
Run-time error '53': File not found
and then going into the debugger shows that the value of file2.name is <File not found>.
I'm not sure what's happening here--is the object reference being lost once the file's renamed? Is there an easier way to let the user rename from a dialog that shows all files in the target directory? I'd also like to provide a default new name for the file, but I can't see how I'd do that using this method.
edit: at this point I'm looking into making a UserForm with a listbox that gets populated w/ the relevant filenames, and an input box with a default value for entering the new name. Still not sure how to hold onto the object reference once the file gets renamed, though.
Here's a sample of using Application.FileDialog to return a filename that the user selected. Maybe it will help, as it demonstrates getting the value the user provided.
EDIT: Modified to be a "Save As" dialog instead of "File Open" dialog.
Sub TestFileDialog()
Dim Dlg As FileDialog
Set Dlg = Application.FileDialog(msoFileDialogSaveAs)
Dlg.InitialFileName = "D:\Temp\Testing.txt" ' Set suggested name for user
' This could be your "File2"
If Dlg.Show = -1 Then
Dim s As String
s = Dlg.SelectedItems.Item(1) ` Note that this is for single-selections!
Else
s = "No selection"
End If
MsgBox s
End Sub
Edit two: Based on comments, I cobbled together a sample that appears to do exactly what you want. You'll need to modify the variable assignments, of course, unless you're wanting to copy the same file from "D:\Temp" to "D:\Temp\Backup" over and over. :)
Sub TestFileMove()
Dim fso As FileSystemObject
Dim SourceFolder As String
Dim DestFolder As String
Dim SourceFile As String
Dim DestFile As String
Set fso = New FileSystemObject
SourceFolder = "D:\Temp\"
DestFolder = "D:\Temp\Backup\"
SourceFile = "test.txt"
Set InFile = fso.GetFile(SourceFolder & SourceFile)
DestFile = DestFolder & SourceFile
If fso.FileExists(DestFile) Then
Dim Dlg As FileDialog
Set Dlg = Application.FileDialog(msoFileDialogSaveAs)
Dlg.InitialFileName = DestFile
Do While True
If Dlg.Show = 0 Then
Exit Sub
End If
DestFile = Dlg.Item
If Not fso.FileExists(DestFile) Then
Exit Do
End If
Loop
End If
InFile.Move DestFile
End Sub
Here's some really quick code that I knocked up but basically looks at it from a different angle. You could put a combobox on a userform and get it to list the items as the user types. Not pretty, but it's a start for you to make more robust. I have hardcoded the directory c:\ here, but this could come from a text box
Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger,
ByVal Shift As Integer)
Dim varListing() As Variant
Dim strFilename As String
Dim strFilePart As String
Dim intFiles As Integer
ComboBox1.MatchEntry = fmMatchEntryNone
strFilePart = ComboBox1.Value
strFilename = Dir("C:\" & strFilePart & "*.*", vbDirectory)
Do While strFilename <> ""
intFiles = intFiles + 1
ReDim Preserve varListing(1 To intFiles)
varListing(intFiles) = strFilename
strFilename = Dir()
Loop
On Error Resume Next
ComboBox1.List() = varListing
On Error GoTo 0
ComboBox1.DropDown
End Sub
Hope this helps. On error resume next is not the best thing to do but in this example stops it erroring if the variant has no files