Actually I have coded the following macro based on FileCopy method.
'MyObject copy function:
Public Function OutputFile(ByVal SrcPath As String, ByVal TrgPath As String) As Boolean
If pDoesFileExist(SrcPath) Then '<= Internal private function to check if file exists
FileCopy SrcPath, TrgPath
OutputFile = True
Else
OutputFile = False
End If
End Function
Invoked from:
'Called subroutine from main program:
Sub OutputFiles(ByRef MyCollection As Collection, SourcePath As String, TargetPath As String)
Dim Obj As MyObject
With MyForm
.Show "Modeless"
For Each Obj In MyCollection
If Obj.OutputFile(SourcePath, TargetPath) Then
.TextBoxResult.Text = .TextBoxResult.Text & "File copied." & vbNewLine
Else
.TextBoxResult.Text = .TextBoxResult.Text & "File not copied!" & vbNewLine
End if
Next Obj
End With
End Sub
The macro works perfectly when I make it run from/to my local computer folders, regardless of the file size (from a few KB to 20MB more or less).
But when I make it run using a work-domain source path (which is obviously slower than my computer), the instruction line FileCopy "freezes" on large files. The program is still running in background and the files are getting copied succesfully, however MyForm will go stucked [No Response] until the end of the execution.
Debugging step-by-step works "fine", I just have to wait that FileCopy instruction returns (10 seconds aprox), then keep moving forward.
I would like to know if there is a possible way to force this "wait until FileCopy returns", or to grant an immunity to the rest of my code against these mini freezes?
Related
Since I am very new to the excel macro I am trying to develop a code which is able to open the PDF file.But There are some PDF files in my system which are generated by another system therefore those files names change day by day and some figures are included too.
As an example,"Process Report 151120183569844" like this.These figures change everyday.I tried it with adding WILDCARD option but it doesn't work.How do I open this PDF with only a part of the file name?
Sub Open_PDF()
Dim pdfPath As String
pdfPath ="D:\Reports\Process Report*" & ".pdf" 'I used wildcard instead "Process Report 151120183569844"'
Call OpenAnyFile(pdfPath)
End Sub
Function openAnyFile(strPath As String)
Set objShell = CreateObject("Shell.Application")
objShell.Open(strPath)
End Function
As pointed out in another answer, the Dir function with a wildcard should do the trick.
Here's an example using the original openAnyFile function.
Sub Open_PDF()
Dim filePath As String, fileName As String
filePath = "D:\Reports\"
fileName = Dir(filePath & "Process Report*.pdf")
If fileName <> "" Then
openAnyFile filePath & fileName
End If
End Sub
Function openAnyFile(strPath As String)
Dim objShell As Object
Set objShell = CreateObject("Shell.Application")
objShell.Open (strPath)
End Function
You cannot open a file using a wildcard - it's just common sense, what if more than one file was matching your criteria - which one would you want to program to open? You have to specify the exact file name to open it.
if there is just one file in the target directory, you can use something like the following code to open it, regardless of its name:
sFound = Dir(ActiveWorkbook.Path & "\Process Report*.xlsm")
If sFound <> "" Then
Workbooks.Open filename:= ActiveWorkbook.Path & "\" & sFound
End If
I wish to check whether a file exist in a folder on my computer. I have below, which can see if a specific file exists:
Function FileExists(sFile As String)
sPath = "M:\User\" & sFile & ".xlsm"
FileExists = Dir(sPath) <> ""
End Function
However, my files are named like: Filename - Version xx.xlsm and is updated regularly. Please note that there will only be one file in the folder, but the filename can vary.
How can I search in the folder using wildcard:
Filename - Version % % and then, if it find any file, open the file afterwards?
One option would be to Open the file inside of the FileExists function. However, I would not recommend doing this. The function should do exactly what the name implies and nothing more.
Another option is restructure your code a little bit:
Private Sub OpenFile()
Dim FileName As String
FileName = GetFile("Filename - Version*")
If FileName <> "" Then
'open FileName as needed
End If
End Sub
Private Function GetFile(sFile As String) As String
sPath = "M:\User\" & sFile & ".xlsm"
GetFile = Dir(sPath)
End Function
I am trying to create a text file in lotus notes which I am running through the agents. The agent ran successfully but the text file is not created in the path which is specified in the lotus script.
This is the lotus script code:
Option Public
Sub Initialize
MsgBox " Agent AccessUserList"
On Error GoTo HandleError
Dim session As New NotesSession
Dim myStream As NotesStream
Dim TheDate As String, filename As String
TheDate=Format(Now(),"mmdd")
filename = "C:"+"\red"+"\color"+TheDate+".txt"
MsgBox filename
Set myStream = session.Createstream()
MsgBox "MySTREAM2"
Call myStream.Open(filename, "ASCII")
MsgBox "MySTREAM3"
Call myStream.Truncate()
MsgBox "Entered View"
closeFile:
Call myStream.Close()
MsgBox "Closed"
Exit Sub
HandleError:
MsgBox "Error - " & Error &" at line number " & Erl
Exit Sub
End Sub
I have scheduled to 5 min to check whether it creates a new file in specified folder
enter image description here
And also the privileges while scheduling I used both second and third
Allow restricted operations
Allow Restricted operations with full administrator rights
But still it shows the folder as empty but the folder time would be changed when this it gets scheduled.
To test it i scheduled the agent to run locally as well as in the server. But the error is same the text file is not created.
Agent log is not having any errors.
enter image description here
I have checked in the logs as well and there is no errors. Can anyone tell what is the mistake in the above code and why my file is not getting created when the agent executes correctly.
NotesStream doesn't work for you as you just want to create an empty file.
Call myStream.Close() always deletes just now created file if it's empty at this point.
Use traditional FreeFile()/Open/Close instead:
Sub Initialize
On Error GoTo HandleError
Dim TheDate As String
Dim filename As String
Dim fileNum As Integer
TheDate = Format(Now(),"mmdd")
filename = "C:\red\color" + TheDate + ".txt"
fileNum = FreeFile
Open filename For Output As fileNum
Close fileNum
Finally:
Exit Sub
HandleError:
MsgBox "Error - " & Error &" at line number " & Erl
Resume Finally
End Sub
When a stream is truncated, property values are: • Bytes is 0 • IsEOS
is True • Position is 0
Closing a stream with zero bytes deletes the associated file.
Your file is getting created and then deleted because it's empty.
I need some way to update an excel addin shared among my staffs so as everyone don't have to download & install it manually.
I have googled and see that we can write file to the OS file system so the task ends up with writing the new-version addin, i.e. the .xlam file, to overwrite itself.
I have no idea on how to do this. If you do have ones, please share! Thank you!
I don't know if there's a less crude way of doing it, but I have "hacked" a solution that involves SendKeys. Yuck, I know. Hopefully someone else will have a better solution.
As I recall, you need to uninstall an addin before you can overwrite the .xla(m) file and I couldn't find a way to do this purely using built-in objects.
The code below basically uninstalls the add-in, invokes the "Add-ins" dialog box and uses SendKeys to remove it from the list, before copying the new file and reinstalling the add-in.
Amend it for your circumstances - it will depend on your users having their security settings low enough to let it run, of course.
Sub UpdateAddIn()
Dim fs As Object
Dim Profile As String
If Workbooks.Count = 0 Then Workbooks.Add
Profile = Environ("userprofile")
Set fs = CreateObject("Scripting.FileSystemObject")
AddIns("MyAddIn").Installed = False
Call ClearAddinList
fs.CopyFile "\\SourceOfLatestAddIn\MyAddIn.xla", Profile & "\Application Data\Microsoft\AddIns\", True
AddIns.Add Profile & "\Application Data\Microsoft\AddIns\MyAddIn.xla"
AddIns("MyAddIn").Installed = True
End Sub
Sub ClearAddinList()
Dim MyCount As Long
Dim GoUpandDown As String
'Turn display alerts off so user is not prompted to remove Addin from list
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Do
'Get Count of all AddIns
MyCount = Application.AddIns.Count
'Create string for SendKeys that will move up & down AddIn Manager List
'Any invalid AddIn listed will be removed
GoUpandDown = "{Up " & MyCount & "}{DOWN " & MyCount & "}"
Application.SendKeys GoUpandDown & "~", False
Application.Dialogs(xlDialogAddinManager).Show
Loop While MyCount <> Application.AddIns.Count
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I use a reversioning addin-manager to do this: basically its a small xla/xlam that never changes thats installed on each users machine. It checks a network share for the latest version of the real addin(s) and opens it as if it was an ordinary workbook: this has the effect of loading the real Addin(s) for the user.
There is a downloadable working example which you can customise here
Another option, this is what I do.
Key points.
Addin version is "some number", file name is always the same.
Installation directory must be known
When asked, the current addin, looks to see if a new version is available. I do this via a system that has a version number in the file name of the "update" and a version number as a const in the code.
Having established I we can update, I go and get the update "package" - in my case I am using an installer and a small vb.net app. If you cant do this then you might want to spin up an insatnce of PPT or word, and use that complete the install.
Next close yourself, or ask the user to close Excel.
Now all we need to do is save the new addin over the old one, with the same file name.
Tell the user its updated, and they should re-open Excel, close the install program.
This works well for me - although you need to remember the numbering system , in the file name and how that code works.
The below is the main guts of the code bit messy, but might help you out.
Private Sub CommandButton1_Click()
Dim RetVal As Long
MsgBox "To install the update, follow the installer programes directions." & vbNewLine & vbNewLine & _
"You will need to then closed down and restart Excel.", vbInformation + vbOKOnly, "::::UPDATE TRS:::::"
RetVal = Shell(gsDataBase1 & "\" & gsUpdatefolder & "\" & GetUpdateFileName(), 1)
ThisWorkbook.Close
Unload Me
End Sub
Private Sub CommandButton2_Click()
gbInUpdate = False
Unload Me
End Sub
Private Sub UserForm_Initialize()
Me.lbNew = GetServerVersion2
Me.lbCurrent.Caption = gcVersionNumber
'CheckVersionNumbers
End Sub
'''This method might be better, but is quite slow.
Public Sub GetServerVersion()
Set objshell = CreateObject("Shell.Application")
Set objFolder = objshell.Namespace(gsDataBase1 & "\" & gsUpdatefolder)
For Each strFileName In objFolder.Items
Me.lbNew.Caption = objFolder.GetDetailsOf(strFileName, 11)
Next
Set objshell = Nothing
End Sub
Public Function IsNewer() As Boolean
Dim curVer As Long
Dim newVer As Long
On Error GoTo Catch
curVer = CLng(Left(Replace(Me.lbCurrent, ".", ""), 2))
newVer = CLng(Left(Replace(Me.lbNew, ".", ""), 2))
If curVer < newVer Then
IsNewer = True
Else
IsNewer = False
End If
Exit Function
Catch:
IsNewer = False
End Function
Private Function GetServerVersion2() As String
On Error GoTo LEH
Dim strDocPath As String
Dim strCurrentFile As String
strDocPath = gsDataBase1 & "\" & gsUpdatefolder & "\"
strCurrentFile = Dir(strDocPath & "*.*")
'gets last file - randomly? should onl;y be one anyway!
'Do While strCurrentFile <> ""
GetServerVersion2 = Right(strCurrentFile, 11)
GetServerVersion2 = Left(GetServerVersion2, 7)
'Loop
Exit Function
LEH:
GetServerVersion2 = "0.Error"
End Function
'Basiclly a coop of GetSeverVerion, but just get the file name so the exe can be called by the shell operation under the update button
''seems clumbys, but works!
Private Function GetUpdateFileName() As String
On Error GoTo LEH
Dim strDocPath As String
Dim strCurrentFile As String
strDocPath = gsDataBase1 & "\" & gsUpdatefolder & "\"
GetUpdateFileName = Dir(strDocPath & "*.*")
Exit Function
LEH:
GetUpdateFileName = "0.Error"
End Function
I am trying to loop through files in a folder on Mac OS X using VBA Excel 2011. I tried the following code, but it does not work.
Sub ListAllFilesInDir()
Dim strFile As String
Dim strPath1 As String
strPath1 = ActiveWorkbook.FullName
MsgBox strPath1
strFile = Dir(strPath1)
MsgBox strFile
strFile = Dir()
MsgBox strFile
strFile = Dir()
MsgBox strFile
End Sub
I get the name of the active workbook when the program reaches the first MsgBox strFile. I read somewhere that using Dir without an argument results in the next file in the folder. But that does not work for me. I get an empty message box for the second MsgBox strFile command and an error (Runtime error 5: Invalid Procedure call or argument" for the third MsgBox strFile command. I have 4 files in the folder that I am trying to loop through.
Also, what would I do to list only ".xslx" files
Here's a link to a description of the dir() function. Your issue is that dir(strPath1) will set the dir function to return all instances of that EXACT filename in that path, which is only ever going to be a single file. If you'd like all files ending in ".xlsx" try:
dir(ActiveWorkbook.Path & application.PathSeparator & "*.xlsx")
Also, if you have an arbitrary number of files you want to loop through try the following code. It works becuase dir returns an empty string after it's returned the last file:
Sub WorkWithFiles()
Const PATH = "C:\"
Dim file As String
file = Dir(PATH & Application.PathSeparator & "*.xlsx")
Do Until file = ""
'Run some code on the file in the file variable
Debug.Print file
'Then get the next file
file = Dir("")
Loop
End Sub