Scenario
I have a file that I am opening as ReadOnly using the following code.
Set wbRead = Workbooks.Open(FilePath, ReadOnly:=True)
Here the FilePath is a variable that tells the file location of that file
Problem
The issue I am facing is, if the user run macro second time without closing this already opened readonly file, it is giving runtime error due to having similar file name opened
What I need
Is there any way whereby excel can open a file as readonly, but the opened file shows some random name?
Eg: Actual file name is A. But when excel open it as readonly, it open as A123? 123 is like a random number.
Abother Solution would be to always (open or not) use Workbooks.Add to create a new copy of your file. Excel will automatically prompt you to save under a new name when you close:
Set wbRead = Workbooks.Add(FilePath)
If the file is already open, make a copy in the temp folder under a different name, and open it from there.
Sub OpenFile()
Const fPath As String = "C:\users\tim\desktop\tmp.xlsm"
Dim fso, wb As Workbook, fName, p
Set fso = CreateObject("scripting.filesystemobject")
p = fPath
fName = fso.getfilename(p)
On Error Resume Next
Set wb = Workbooks(fName)
On Error GoTo 0
If Not wb Is Nothing Then
p = fso.GetSpecialFolder(2) & "\" & Round(Rnd() * 1000, 0) & "_" & fName
fso.copyfile fPath, p
End If
Workbooks.Open p
End Sub
Related
I'm trying to convert a little over 200 .txt files into .xlsx files. This is the code I'm using:
Dim wb As Excel.Workbook
Dim FSO As New FileSystemObject
Dim obj_folder As Object
Dim file As Object
Dim path As String
Dim destination As String
Dim file_name As String
path = "C:\Users\ABCD\Desktop\Attributes Files\"
destination = "C:\Users\ABCD\Desktop\Attributes xlx\"
Set FSO = CreateObject("Scripting.filesystemobject")
Set obj_folder = FSO.GetFolder(path)
For Each file In obj_folder.Files
file_name = Left(file.Name, (InStrRev(file.Name, ".", -1, vbTextCompare) - 1))
Call Workbooks.OpenText(Filename:=file, DataType:=xlDelimited, Tab:=True)
Set wb = ActiveWorkbook
wb.SaveAs Filename:=destination & file_name & ".xlsx"
wb.Close savechanges:=False
Next file
When the code is finished running and I go to open the .xlsx workbook, I receive an error that states Excel cannot open the file because the file format or file extension is not valid. Verify that the file has not been corrupted and that the file extension matches the format of the file.
I'm not sure what to do here as I know this works when I manually change one .txt file workbook to a .xlsx file type. I even recorded the macro and it more or less matches up with my code that I have here. (on one attempt I even copied down the recorded macro exactly and it still wouldn't let me open the .xlsx file after it finished.) Any help would be appreciated.
You never cite what file format you save in. You want to use xlOpenXMLWorkbook = 51
It looks like you pass the object file to the Filename paramter of open. I would use file.Name just like you do when you are building the output name.
Using a With block will gracefully handle the workbook object for you.
FSO.GetBaseName will remove the extension of the filename for you.
Dim FSO As New FileSystemObject
Set FSO = CreateObject("Scripting.filesystemobject")
Dim path As String
path = "C:\Users\ABCD\Desktop\Attributes Files\"
Dim destination As String
destination = "C:\Users\ABCD\Desktop\Attributes xlx\"
Dim file As Object
For Each file In FSO.GetFolder(path).Files
Dim file_name As String
file_name = FSO.GetBaseName(file.Name)
With Workbooks.OpenText(Filename:=file.Name, DataType:=xlDelimited, Tab:=True)
.SaveAs Filename:=destination & file_name & ".xlsx", FileFormat:=51
.Close savechanges:=False
End With
Next file
I have a number of corrupted .xlsx files in a directory.
I want to open every single file for repair and save it with the same name via VBA script.
I`ve tried following piece of code to solve this problem:
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = ActiveWorkbook.Path & "\output\"
Filename = Dir(Pathname & "*.xlsx")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename, CorruptLoad:=xlRepairFile)
wb.Close SaveChanges:=True
Filename = Dir()
Loop
End Sub
But this code only repairs first file and opens windows explorer to save file manualy.
Is there a way to perform repair and save all files with the same name in the same folder automatically?
I haven't touched VBA in years, but there is an explicit wb.SaveAs method you can call.
Have you set Application.DisplayAlert = False? Your codes seems fine. You just have to turn it on later.
Very new to this so please help. Im trying to mass update files in a static folder location, many files in one folder.
What i want to do is
run VBA macro in Excel 2010 to goto a network location folder,
open the first file in the folder.
Unprotect the workbook and worksheets call another marco to run changes
then protect the worksheet close the file
and then move onto the next file in the folder until all files have been corrected.
I have created the marco to make the changes, this is called "Edit"
File types are xlsm and the workbook and worksheet are password protected How can i automatically run the macro to goto the network location and in series open each file, unprotect, call the macro, then re protect the document close file and move onto the next file until they are all updated.
Sub Auto_open_change()
Dim WrkBook As Workbook
Dim StrFileName As String
Dim FileLocnStr As String
Dim LAARNmeWrkbk As String
PERNmeWrkbk = ThisWorkbook.Name
StrFileName = "*.xlsx"
FileLocnStr = ThisWorkbook.Path
Workbooks.Open (FileLocnStr & "\" & StrFileName)
Workbooks(StrFileName).Activate
With Application.FindFile
SearchSubFolders = False
LookIn = "Network location"
Filename = "*.xlsm"
If .Execute > 0 Then
Debug.Print "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
WrkBook = Workbooks.Open(Filename:=.FoundFiles(i))
WrkBook.Worksheets(1).Select
ThisWorkbook.Worksheets(1).Cells(DestinationRange) = WrkBook.Worksheets(1).Cells(SourceRange).Value
Next i
Else
Debug.Print "There were no files found."
End If
Im managing to unprotect the file update and reprotect the file fine, just cant get the file from the network location.
I'm using Excel 07, which doesn't allow Application.FindFile, so I can't test this. However, I believe the issue may be that you need to Set the variable Wrkbook, not just assign it.
Change
WrkBook = Workbooks.Open(Filename:=.FoundFiles(i))
to
Set WrkBook = Workbooks.Open(Filename:=.FoundFiles(i))
and let me know how that turns out!
I'm using the following code to open multiple xml files, however they are opening as a read only workbook, however I require it to open as an XML table, any suggestions?
Code:
Sub AllFolderFiles()
Dim wb As Workbook
Dim TheFile As String
Dim MyPath As String
MyPath = "C:\Documents and Settings\"
ChDir MyPath
TheFile = Dir("*.xml")
Do While TheFile <> ""
'Call Logs 'This calls for Macro2 to run
Set wb = Workbooks.Open(MyPath & "\" & TheFile)
MsgBox wb.FullName
'wb.Close
TheFile = Dir
Loop
End Sub
You need to use Workbooks.OpenXML instead
Set wb = Workbooks.OpenXML(Filename:=MyPath & "\" & TheFile, LoadOption:=xlXmlLoadImportToList)
I'm not exactly which LoadOption you want to use, but you can choose from:
xlXmlLoadImportToList Automatically creates an XML List and imports
data into the list.
xlXmlLoadMapXml Loads the XML file into the XML Source task pane.
xlXmlLoadOpenXml Open XML files in the same way that Excel 2002
opens XML files (for backwards compatibility only).
xlXmlLoadPromptUser Prompts the user and lets them choose the Import
method.
We have been using VBA code for years with Excel 2003. I have about 70 files that I pull information from and compile it into one spreadsheet. This time, it only recognizes 3 of the 70. I do not get any errors. I noticed that all 3 recognized are the old version ".xls." and all not being recognized are the ".xlsx". The portion of the code that I think is causing the problem is below. Can anyone help?
Public currApp As String
Public i As String
Public recordC As String
Public excelI As Integer
Public intFileHandle As Integer
Public strRETP As String
Public errFile As String
Public Function loopFiles(ByVal sFolder As String, ByVal noI As Integer)
'This function will loop through all files in the selected folder
'to make sure that they are all of excel type
Dim FOLDER, files, file, FSO As Object
excelI = noI
'MsgBox excelI
i = 0
'Dim writeFile As Object
'writeFile = My.Computer.FileSystem.WriteAllText("D:\Test\test.txt", "sdgdfgds", False)
Dim cnn As Connection
Set cnn = New ADODB.Connection
currApp = ActiveWorkbook.path
errFile = currApp & "\errorFile.txt"
If emptyFile.FileExists(errFile) Then
Kill errFile
Else
'Do Nothing
End If
'cnn.Open "DSN=AUTOLIV"
'cnn.Open "D:\Work\Projects\Autoliv\Tax workshop\Tax Schedules\sox_questionnaire.mdb"
cnn.Open ("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & currApp & "\tax_questionnaire.mdb")
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Set FSO = CreateObject("Scripting.FileSystemObject")
'Upon each found excel file it will make a call to saveFiles.
If sFolder <> "" Then
Set FOLDER = FSO.getfolder(sFolder)
Set files = FOLDER.files
For Each file In files
'ONLY WORK WITH EXCEL FILES
If file.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open fileName:=file.path
xlsx is a "macro-free" workbook. To use VBA in the new file format, the file must be saved as an xlsm file.
EDIT: I read the question too hastily. If you want to identify excel files from the FSO object, use file.Type LIKE "Microsoft Excel *" or similar. Or, check the file's extension against ".xls*"
EDIT
The whole concept of identifying the file type by looking at the file name is fundamentally flawed. It's too easily broken by changes to file extensions and/or the "type" texts associated with those descriptions. It's easily broken by, say, an image file named "file.xls". I would just try opening the file with Workbooks.Open and catch the error. I'd probably put this logic in a separate function:
Function OpenWorkbook(strPath As String) As Workbook
On Error GoTo ErrorLabel
Set OpenWorkbook = Workbooks.Open(strPath)
ExitLabel:
Exit Function
ErrorLabel:
If Err.Number = 1004 Then
Resume ExitLabel
Else
'other error handling code here
Resume ExitLabel
End If
End Function
Then you can consume the function like this:
Dim w As Workbook
Set w = OpenWorkbook(file.Path)
If Not (w Is Nothing) Then
'...
The problem you're having has to do with this line:
If file.Type = "Microsoft Excel Worksheet" Then
Try adding and replacing it with this:
// add these lines just AFTER the line 'For Each file In files'
IsXLFile = False
FilePath = file.path
FilePath2 = Right(FilePath, 5)
FilePath3 = Mid(FilePath2, InStr(1, FilePath2, ".") + 1)
If UCase(Left(FilePath3, 2)) = "XL" Then IsXLFile = True
// replace faulty line with this line
If IsXLFile = True Then
Let me know how it works. Yes, it'd be possible to compress the statements that start with FilePath into one expression but I left it like that for clarity. Vote and accept the answer if good and follow-up if not.
Have a nice day.