When I run the following dir loop, the files that open prompt to update the links even though the code says to update them. Does anyone know why I'm still prompted to update? I have a feeling its related that my directory is sharepoint.
Sub OpenProjectFiles()
Dim sFile As String
Dim sPath As String
sPath = Application.ActiveWorkbook.Path
sPath = Replace(sPath, "/", "\")
sPath = Replace(sPath, "http:", "")
sFile = Dir(sPath & "\FY*.xls")
Do While Len(sFile) > 0
On Error Resume Next
Workbooks.CheckOut FileName:=sPath & "\" & sFile
Workbooks.Open FileName:=sPath & "\" & sFile, UpdateLinks:=3
sFile = Dir
Loop
End Sub
I actually figured out my own question, explained below. However I would love insight if there's a better or faster way to cycle through and open these files. Currently it takes about 6 seconds to find, check out, open and update the links--updating the links doesn't take long since it normally isn't much information to update. And since this routine will normally open about 10-15 files it almost takes about 2 minutes to complete.
Answer: what I realized was the code was in fact updating the links but for some reason the prompt was still popping up. So I just disabled the prompt with:
Application.AskToUpdateLinks = False
Related
I have many macros that have the following path definition:
"X:\Test\3rd Party\Other Files\"
But what I need to, which is what I did with the vbscripts, is make it like this:
"\\ServerName\Folder\Test\3rd Party\Other Files\"
This is because the files that have the macros in them are on the server and they need to be able to be executed by anyone who has access to the server - and since each person might map the drive with a different letter and/or have different levels of access, the first option wont work.
When I use this:
"\\ServerName\Folder\Test\3rd Party\Other Files\"
I get the error:
Sorry, we couldn't find \ServerName\Folder\Test\3rd Party\Other
Files. Is it possible it was moved, renamed or deleted?
When I use this:
"\\ServerName\Folder\Test\3rd Party\Other Files"
Note the backslash missing at the end of the string
I get the error:
Excel cannot access "Other Files". The document may be read-only or
encrypted.
Sub RenameOriginalFilesSheets()
Const TestMode = True
Dim WB As Workbook
Application.ScreenUpdating = False
rootpath = "\\ServerName\Folder\Test\Terminations\"
aFile = Dir(rootpath & "*.xlsx")
Do
Set WB = Application.Workbooks.Open(rootpath & aFile, False, AddToMRU:=False)
WB.Sheets(1).Name = Left$(WB.Name, InStrRev(WB.Name, ".") - 1)
WB.Close True
aFile = Dir()
DoEvents
Loop Until aFile = ""
Application.ScreenUpdating = True
End Sub
Try this, I test in VBA and it works.
Sub serverfolder()
Dim StrFile As String
StrFile = Dir("\\ServerIP\Folder\" & "*")
Do While StrFile <> ""
StrFile = Dir
Loop
End Sub
I've been trying to do something REALLY simple here but, for whatever the reason, it's not working.
All that I'm trying to do is to get all the .txt files from a specific directory using a wildcard.
Here is the full code that I'm using:
Sub RenameFiles()
'Variables Declaration
Dim vSpreadsheetPath As String
Dim vFolderName As String
Dim vFilesPath As String
Dim vFile As String
Dim vRow As Long
Dim vFilter As String
'Getting the vFile path
vSpreadsheetPath = ActiveWorkbook.Path
vFolderName = "COMBINED FOLDER"
vFilter = "*.txt"
vFilesPath = vSpreadsheetPath & Application.PathSeparator & vFolderName & Application.PathSeparator
vFile = Dir(vFilesPath & vFilter)
MsgBox (vFile)
End Sub
But nothing shows in the result.
The weirdest thing is:
If I use
file = Dir(vFilesPath & "filename.txt")
It works
But if I try to use any Wildcard, like the one bellow, it doesn't.
file = Dir(vFilesPath & "filename.t*")
Any idea of what I might be doing wrong?
It is relevant that you're on a Mac since Mac's don't use wildcards like Windows.
You'll need a different approach or a new (re-worded) question for more information about handling the Mac file system with VBA.
This should help get you started.
(Posted as an answer by O.P. request.) :-)
I want to open and copy sheet in file TFM_20150224_084502 and this file has different date and time each day. I have developed code until open the date format but I can't develop to open it with time format.
What's the more code for it?
Sub OpenCopy ()
Dim directory As String, fileName As String, sheet As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "z:\FY1415\FI\Weekly Report\Astry"
fileName = "TFM_" & Format(Date, "yyyymmdd") & ".xls"
Workbooks.Open "z:\FY1415\FI\Weekly Report\Astry\" & "TFM_" & Format(Date, "yyyymmdd") & ".xls"
Sheets("MSP").Copy After:=Workbooks("Generate Report 2.xlsm").Sheets("PlanOEE")
ActiveSheet.Name = "MSP"
End sub
It seems that some linebreaks have disappeared when you posted the code into your post, but assuming you are aware of this, I assume that the main problem you have is figuring out the name of the file you want to open?
The VBA Dir-function lets you search for a file in a folder, and lets you include wildcards in your search. I've included this function in your sub, and have tested it with a similarly named file on my computer (albeit without the copying of the sheet), and it opened the sheet:
Sub OpenCopy()
Dim directory As String, fileName As String, sheet As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "z:\FY1415\FI\Weekly Report\Astry\"
fileName = Dir(directory & "TFM_" & Format(Date, "yyyymmdd") & "*.xls*")
If fileName <> "" Then
With Workbooks.Open(directory & fileName)
.Sheets("MSP").Copy After:=Workbooks("Generate Report 2.xlsm").Sheets("PlanOEE")
End With
ActiveSheet.Name = "MSP"
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
The line relevant for finding the filename is, as you probably see:
fileName = Dir(directory & "TFM_" & Format(Date, "yyyymmdd") & "*.xls*")
I have simply used Dir to do a search for file fitting the string inside the parantheses, where the asterisks are wildcards. The reason I have included an asterisk after xls too is because there is a chance the file can have extensions such as xlsx or xlsm in newer versions of office. I've also added a backslash at the end of the directory string, since you'll have to include it before the filename anyway.
I have also added an if-clause around what you do with the workbook you open, in case no file fitting the search is found.
Note that this sub will only do what you want provided that there only is one file generated for each date. If you want to loop through all files which includes a given date, I would recommend having a look at this post here on SO, which explains how to loop through all files in a folder, modifying the macros presented there to fit your needs should be fairly trivial.
The following VBA code is meant to run on MS Office 2003. Because that's what our multi-billion dollar corporation gives us to work with. =)
The good news. It works perfectly if I'm editing code in the IDE and hit save. Same if I'm working on the spreadsheet itself. Creates a backup folder if none exists, and saves a dated backup copy in it.
The bad news. When I run the main macro (too large to post), the code below executes but does not save a backup copy. The event is called correctly. In fact, it will create a backup folder if none exists. Every line gets run. The variables are all correct. Error handling works.
Simply put, ThisWorkbook.SaveCopyAs won't work if the main macros is running and calls ThisWorkbook.Save.
I only learned VBA a couple months ago for this particular project, so apologies if there is something obvious. However, I read all the relevant MSDN documentation and Googled like mad, but nothing came up.
Thanks in advance for your assistance.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'********************************************************************
'Purpose: Triggered by ThisWorkbook.BeforeSave event
' Creates backup folder and saves date appended copies
'********************************************************************
Dim strBackupPath As String 'Path to Backup Folder
Dim strFarkPath As String 'Path to running workbook
Dim strBackupName As String 'Filename of backup
Dim strFullName As String 'Full path & filename of running workbook
Dim strBackupExtension As String 'Extension of backup
Dim strDestination As String 'Full path & filename of backup
Dim strDrive As String 'Drive letter
strFarkPath = Application.ActiveWorkbook.Path
strDrive = Left(strFarkPath, 1)
strBackupPath = strFarkPath & "\_Backups"
strBackupName = "\Backup-" & Year(Now) & "-" & Month(Now) & "-" & Day(Now)
strFullName = Application.ActiveWorkbook.FullName
strBackupExtension = Right(strFullName, Len(strFullName) - InStrRev(strFullName, ".", -1, vbTextCompare) + 1)
strDestination = strBackupPath & strBackupName & strBackupExtension
On Error GoTo Incorrect
If Len(Dir(strBackupPath, vbDirectory)) = 0 Then
MkDir strBackupPath
End If
Application.DisplayAlerts = False
ThisWorkbook.SaveCopyAs Filename:=strDestination
Application.DisplayAlerts = True
Exit Sub
Incorrect:
MsgBox "Unable to back record keeper up. Next time, please run the program from a location where you can read and write files.", vbCritical + vbOKOnly
End Sub
Here's the last part of your existing sub, modified to create a copy.
Note you cannot use the built-in FileCopy to make the copy (you'll get "Permission Denied")
On Error GoTo Incorrect
If Len(Dir(strBackupPath, vbDirectory)) = 0 Then
MkDir strBackupPath
End If
Application.DisplayAlerts = False
Application.EnableEvents = False
ThisWorkbook.Save
CreateObject("scripting.filesystemobject").copyfile _
ThisWorkbook.FullName, strDestination
Application.EnableEvents = True '<<<<
Application.DisplayAlerts = True
Exit Sub
Incorrect:
Application.EnableEvents = True 'never leave this False!
MsgBox "Unable to back record keeper up. Next time, please run the program from a location where you can read and write files.", vbCritical + vbOKOnly
End Sub
I have Word survey files, each containing forms filled by subjects. Until now I have manually exported the forms data by saving as txt and choosing the option "save form data as delimited text file".
I want to programmatically save as delimited text file all the .doc documents in a given directory. Alternatively, if this were to be too complicated, it would be sufficient to save one file at a time. The new txt files must have the same name as the original .doc files.
Thanks for your input Jan Schejbal. I've reached a solution with this piece of code, so I share it for whose who encounter the same problem. I received help from here
Sub Save_Forms_Data()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document, strDocName As String
strFolder = CurDir
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
strDocName = Left(.FullName, InStrRev(.FullName, ".")) & "txt"
.SaveAs2 FileName:=strDocName, FileFormat:=wdFormatText, AddToRecentFiles:=False, _
SaveFormsData:=True, Encoding:=1252, InsertLineBreaks:=False, LineEnding:=wdCRLF
.Close SaveChanges:=False
End With
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
Application.Quit SaveChanges:=wdDoNotSaveChanges
End Sub
You can record a macro, which means you start the recording, do certain actions, then stop the recording, and VBA code for said actions is automatically generated. The code may not be very clean, but it should give you a good start to show you how the syntax looks and what commands you need for your actions. For certain things (e.g. dynamically specifying the file name), you will need to consult the documentation, but if you have any programming experience in any common language, this should not pose a significant problem once you have the "skeleton" provided by the macro recorder.
The more you want to automate, the more VBA you will need to learn. As VBA really isn't difficult, and it seems like you have a lot of repetitive work in front of you if you don't automate it, I'd suggest you learn it and Google what you need. This way, you will get your work done in a similar timeframe (or less, especially if this is not just a one-off thing), you will have a macro to do it next time, it will be less boring, and you will have learned a bit of VBA.