I am working with some excel files. The idea is to take only those that have been modified. But here I got the problem. When I am executing the all package, the Excel connector is modifying the the "date modified" with the system hour. These files have not the property "Read Only", and I can not do nothing regarding this because I just read the files from a specific folder.
What would be the best approach to face this issue?.
This way you can Read the modified date of a file without open it, all from excel.
Sub test()
Dim FD As FileDialog
Dim i
Set FD = Application.FileDialog(msoFileDialogFilePicker)
With FD
If .Show = -1 Then
For Each i In .SelectedItems
MsgBox FileLastModified(i)
Next i
End If
End With
End Sub
Function FileLastModified(ByVal strFullFileName As String)
Dim fs As Object
Dim f As Object
Dim s As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(strFullFileName)
s = UCase(strFullFileName) & vbCrLf
s = s & "Last Modified: " & f.DateLastModified
FileLastModified = s
Set fs = Nothing: Set f = Nothing
End Function
Related
I have a piece of code that checks if an excel file opened or not by someone and display that user's username if it is opened. It was working fine, but recently it is throwing some error as shown in picture. But the error occurs only sometimes and not always. Anyone knows why?
Sub TestFileOpened()
Dim Folder As String
Dim FName As String
Dim fileOpenedOrNot As String
fileOpenedOrNot = "\\122.00.00.000\shared\Admin Confidential\Admin_Planner Database\Admin\Templates and Files\~$Running Numbers and ComboBox Lists.xlsx"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(fileOpenedOrNot) Then
fileInUse = True
MsgBox "Database is opened and using by " & GetFileOwner(fileOpenedOrNot) & ". Please wait a few seconds and try again", vbInformation, "Database in Use"
Else
fileInUse = False
End If
End Sub
Function GetFileOwner(strFileName)
Set objWMIService = GetObject("winmgmts:")
Set objFileSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting='" & strFileName & "'")
intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)
If intRetVal = 0 Then
GetFileOwner = objSD.Owner.Name
Else
GetFileOwner = "Unknown"
End If
End Function
The following is the line that throwing error
objWMIService.Get("Win32_LogicalFileSecuritySetting='" & strFileName & "'")
Update 1
After further checks, I noticed there were no temp file ~$Running Numbers and ComboBox Lists.xlsx created although that file is opened. Basically objFSO.FileExists(fileOpenedOrNot) setting to true and going into that if condition. But when it calls the GetFileOwner function, it is not seeing the file and probably that is why have the error.
Like I mentioned, this code was working earlier without issues, but all of a sudden having such problem. Anyone knows why there is no such temp file created?
Check if this method works for you. Looks like it works for me better than yours but still it throws me Predefined\Administrators as owner on the network instead of the correct user name.
Option Explicit
Public Sub test()
Const fileOpenedOrNot As String = "\\122.00.00.000\shared\Admin Confidential\Admin_Planner Database\Admin\Templates and Files\~$Running Numbers and ComboBox Lists.xlsx"
Dim objFSO As FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(fileOpenedOrNot) Then
Dim objFile As Object
Set objFile = objFSO.GetFile(fileOpenedOrNot)
MsgBox GetFileOwner(objFile.ParentFolder & "\", objFile.Name)
End If
End Sub
Public Function GetFileOwner(ByVal fileDir As String, ByVal fileName As String) As String
Dim securityUtility As Object
Set securityUtility = CreateObject("ADsSecurityUtility")
Dim securityDescriptor As Object
Set securityDescriptor = securityUtility.GetSecurityDescriptor(fileDir & fileName, 1, 1)
GetFileOwner = securityDescriptor.Owner
End Function
Good morning,
I would like to convert the PDF file to Word one (from PDF to DOCX) using Excel macro.
So far I learned the process from this video:
https://www.youtube.com/watch?v=Op25fUfvIl0
and this link:
https://www.pk-anexcelexpert.com/pdf-to-word-converter-macro-in-excel-vba/
but the problem is, that the example is based on the certain cells including the fixed file directory:
pdf_path = sh.Range("E4").Value
word_path = sh.Range("E5").Value
I would like to have always directory the same as my active workbook, which I am working on.
In this event I tried the following code:
Sub Wort_To_PDF()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayStatusBar = True
Dim pdf_path As String
Dim word_path As String
pdf_path = ThisWorkbook.Path & "\"
word_path = ThisWorkbook.Path & "\"
Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File
Set fo = fso.GetFolder(pdf_path)
Dim wa As Object
Dim doc As Object
Set wa = CreateObject("word.application")
wa.Visible = True
Dim file_Count As Integer
For Each f In fo.Files
Application.StatusBar = "Converting - " & file_Count + 1 & "/" & fo.Files.Count
Set doc = wa.Documents.Open(f.Path)
doc.SaveAs2 (word_path & "\" & Replace(f.Name, ".pdf", ".docx"))
doc.Close False
file_Count = file_Count + 1
Next
wa.Quit
MsgBox "All PDF files have been converted in to word", vbInformation
Application.StatusBar = ""
End Sub
I am getting an error "Type mismatch" pointing the following line:
Set fo = fso.GetFolder(pdf_path)
I found some hints regarding the usage of active workbook directory in VBA
How to get the path of current worksheet in VBA?
and tried to put it into my code:
pdf_path = Application.ActiveWorkbook.Path
word_path = Application.ActiveWorkbook.FullName
but the error is exactly the same.
Can anyone help me? I would like to convert the PDF file to docx in the same directory, where my active workbook is stored.
UPDATE:
When I change Dim fo as Folder to Dim fo As Object or Dim fo as Scripting.Folder I am getting another error, informing me, that file is corrupted. Debugger shows the following line:
Set doc = wa.Documents.Open(f.Path)
I think, that problem might be somewhere with my excel document, which is already opened and used. In general, the code executes the first sheet only instead of all of them.
The code could fail because ActiveWorkbook.Path contains something invalid:
If the ActiveWorkbook is a new workbook that was not saved yet, Path is empty - you will get Runtime error 5 (Invalid Argument)
If ActiveWorkbook is on a Sharepoint site or something like that, Path might be an URL - you will get Runtime error 76 (Path not found)
However in your case, it seems that the returned object of the GetFolder-method returns something that is not expected by the VBA runtime. It might be case that you have a type definition Folder somewhere that hides the Folder-type of the Scripting Library. Declare your variable qualified:
Dim fo as Scripting.Folder
Do so for all the other scripting object (f for example)
If you add a reference to the Microsoft Word 16 Object Library, you can also declare the word objects with the correct type, eg
Dim wa as Word.Application
Dim doc as Word.Document
Update: If you loop over all files of the folder, make sure you open only Word files with the Word.Application. Opening some other kind of files will throw errors like the one you see (might be corrupt)
Add a check for the filetype before you open it - you want to convert only word files:
For Each f In fo.Files
if fso.GetExtensionName(f.Name) like "doc*" Then
Set doc = wa.Documents.Open(f.Path)
doc.SaveAs2 (word_path & "\" & Replace(f.Name, ".pdf", ".docx"))
doc.Close False
file_Count = file_Count + 1
End If
Next f
Trying to use the most recent file in folder for data.
My problem is that my master excel file wont use the data from the most recent data file (xlsx) to pull the data. My code currently has the name of the current file (eg. "Network-2019.xlsm") but lets say i insert a file called "network.xlsm, which is posted in the folder later. I want main dataset to recognize this and pull in that data.
Function GetMostRecentExcelFile(ByVal myDirectory As String, ByVal filePattern As String) As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim myFolder As Object
Set myFolder = fso.getfolder(IIf(Right(myDirectory, 1) = "\", myDirectory, myDirectory & "\"))
Dim currentDate As Date
Dim fname As String
Dim currentFile As Object
For Each currentFile In myFolder.Files
If (currentDate = CDate(0) Or currentFile.DateCreated > currentDate) And currentFile.name Like filePattern _
And InStr(LCase$(currentFile.name), ".xlsx") > 0 And InStr(currentFile.name, "~$") = 0 Then
currentDate = currentFile.DateCreated
fname = currentFile.name
End If
Next currentFile
GetMostRecentExcelFile = fname
End Function
I would suggest something like below, since you are using the FileSystemObject
Note that I used early binding. The associated intellisense is quite useful, and you can always change to late binding if you need to for any reason.
Option Explicit
Function GetMostRecentExcelFile(sFolderPath As String) As String
Dim FSO As FileSystemObject
Dim FO As Folder, FI As File, recentFI As File
Set FSO = New FileSystemObject
Set FO = FSO.GetFolder(sFolderPath)
For Each FI In FO.Files
Select Case FI.Name Like "*.xlsx"
Case True
Select Case recentFI Is Nothing
Case True
Set recentFI = FI
Case False
If FI.DateCreated > recentFI.DateCreated Then
Set recentFI = FI
End If
End Select
End Select
Next FI
GetMostRecentExcelFile = recentFI.Path
End Function
I have script that printing specific file, but it's getting hard to make over 150 .vbs files for each document to be printed,
is there any way to have pop-out window where i can type file name, then script find it in folder and print it with 20 copies.
I have PDF, WORD and Excel files
this is what i have now for them
Dim AppExcel
Set AppExcel = CreateObject("Excel.application")
AppExcel.Workbooks.Open"directory\filename.xlsx"
AppExcel.Visible = True
AppExcel.ActiveWindow.SelectedSheets.PrintOut,,20
Appexcel.Quit
Set appExcel = Nothing
filename = "\\MCSERVER01\Data\Forms\Vehicle inspection forms\daily vehicle inspection form.pdf"
Set sh = CreateObject("WScript.Shell")
sh.Run "sumatrapdf.exe -print-to-default """ & filename & """", 0, True
Dim AppWord
Set AppWord = CreateObject("Word.application")
AppWord.Documents.Open"\\MCSERVER01\Data\Forms\DODD\SMALL CAR DRIVERS\Akira Litman.docx"
AppWord.Visible = True
AppWord.ActiveDocument.PrintOut
AppWord.Quit
Set appWord = Nothing
Perhaps you can make use of an input box
Dim fileToPrint As String
fileToPrint = InputBox("Enter file name to print")
I got some help from my old friend, but now i can't get another part working
set fso = CreateObject("Scripting.FileSystemObject")
call main
sub main
InputName = InputBox("ENTER YOUR NAME")
if instr(InputName, ".") = 0 then
msgbox("DON'T NEED THIS AT ALL!!!!!")
exit sub
end if
'msgbox(mid(InputName, instr(InputName, ".")+1))
select case mid(InputName, instr(InputName, ".")+1)
case "xlsx"
call printExcel(InputName)
end select
end sub
sub printExcel(fileName)
Dim AppExcel, path
Set AppExcel = CreateObject("Excel.application")
path = "\MCSERVER01\Data\Forms\Access2Care\WHEELCHAIR DRIVERS\"
if fso.FileExists(path & fileName) then
AppExcel.Workbooks.Open path & fileName
AppExcel.Visible = false
AppExcel.ActiveWindow.SelectedSheets.PrintOut,,20
Appexcel.Quit
Set appExcel = Nothing
else
X=MsgBox ("Wrong File Name Or File Doesn't Exist" ,0+16, "Please Re-Enter Your Full Name")
end if
end sub
so the issue i have now is that i have to type in file extension to make it work otherwise im getting msgbox with "don't need this"
how i can get rid of that msg and just have default extension as xlsx xsl
My code asks the user to input a file name. We'll say we have 5 text files in directory "C:\Users\aUser\Desktop\myFolder". These text files are named A, B, C, D, and E.
If the text file exists, then I would like to write over the contents with a script I've already made. If the text file does not exist, I would like to make one with the file name they inputted, and populate it [with the script I've already written].
Thanks for your help.
The way you explain it, it seems that the easiest workflow would be:
1) Delete the file if exists
Sub test()
Dim FSO As FileSystemObject
Dim sPath As String
sPath = "U:\Test.txt"
Set FSO = New FileSystemObject
If FSO.FileExists(sPath) Then
FSO.DeleteFile (sPath)
End If
End Sub
Copy the script (I assume also a txt file) into the path:
FileCopy "U:\Script", sPath
If you have the script in a string variable:
Set txtFile = FSO.CreateTextFile(sPath, True)
txtFile.WriteLine(sText)
FSO.Close
End Sub
If the script is contained in an array, you can loop through the array and produce multiple writelines.
Don't forget to reference the Microsoft Scripting Runtime library.
Something like this
locates the folder for the logged on user regardless of OS
checks that the user input file is contained in a master list (held by StrFiles)
then either creates a new file if it doesn't exist, or
provides a logic branch for you to add your overrwrite script
Sub
code
GetFiles()
Dim wsShell As Object
Dim objFSO As Object
Dim objFil As Object
Dim strFolder As String
Dim StrFile As String
Dim StrFiles()
StrFiles = Array("A.txt", "B.txt", "C.txt")
Set wsShell = CreateObject("wscript.shell")
strFolder = wsShell.specialFolders("Desktop") & "\myFolder"
StrFile = Application.InputBox("Please enter A.txt, B.txt", "File Selection", , , , , 2)
If IsError(Application.Match(StrFile, StrFiles, 0)) Then
MsgBox StrFile & " is invalid", vbCritical
Exit Sub
End If
If Len(Dir(strFolder & "\" & StrFile)) = 0 Then
'make file
Set objFSO = CreateObject("scripting.filesystemobject")
Set objFil = objFSO.createtextfile(strFolder & "\" & StrFile, 2)
objFil.Close
Else
'write over file
'add your code here
End If
End Sub