When trying to run the below I get the following error:
"This extension can not be used with
the selected file type. Change the
file extension in the file name text
box or select a different file type by
changing the save as type."
Code:
Dim strPath As String
Dim strFolderPath As String
strFolderPath = "Y:\
strPath = strFolderPath & _
Sheet1.Range("A1").Value & _
Sheet1.Range("B1").Value & ".xlsx"
ActiveWorkbook.SaveAs Filename:=strPath
The error means that the ActiveWorkbook is trying to save as a different file format then ".xlsx". To force it to save as .xlsx, you also have to pass the fileformat.
ActiveWorkbook.SaveAs Filename:=strPath, FileFormat:=xlOpenXMLWorkbook
I had the same problem when I was trying to convert a macro enabled workbook (xlsm) into a normal workbook (xlsx)! I finally gave up using the ActiveWorkbook.SaveAs method and used the following code instead:
' Code from http://www.mrexcel.com/forum/excel-questions/516366-saving-xlsm-file-xlsx-using-visual-basic-applications.html#post4478019
sub saveAsXlsx
Dim mySheetList() As String
ReDim mySheetList(0 To (ThisWorkbook.Sheets.Count) - 1)
Dim a As Integer
a = 0
For Each ws In ActiveWorkbook.Worksheets
mySheetList(a) = ws.Name
a = a + 1
Next ws
'actually save
Worksheets(mySheetList).Copy
ActiveWorkbook.SaveAs fileName:=flenme 'default ext
The code is originally from here.
Related
I have a workbook that I format through macros I recorded. The macros currently rename the file and save it to a constant path, but I need it to rename the file and save it to a relative path so that other teammates can use it. Are there any suggestions?
This is the active file
Windows("Manual Reconciliation Template.xlsm").Activate
This is the constant path
ActiveWorkbook.SaveAs FileName:= _
"C:\Users\e6y550m\Documents\MANUAL RECS\Manual Reconciliation Template.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Current code:
Sub Name_And_Save_Report()
'
' TO NAME, DATE AND SAVE THE REPORT AFTER IT HAS BEEN WORKED.
'
Windows("Manual Reconciliation Template.xlsm").Activate
Dim thisWb As Workbook
Dim fname
fname = InputBox("Enter your name (example-John):")
Set thisWb = ActiveWorkbook
Workbooks.Add
ActiveWorkbook.SaveAs FileName:=thisWb.Path & "\" & fname & "_Manual Recon" & " " & Format(Date, "MM.DD.YY") & ".xlsx"
ActiveWorkbook.Close savechanges:=False
Windows("Manual Reconciliation Template.xlsm").Activate
ActiveWorkbook.Close savechanges:=False
End Sub
So, you'll paste a copy of the workbook containing the above code in each persons folder. When they open the workbook you want it to rename itself as:
<< person name >>_Manual Recon << mm.dd.yy >>.xlsx
I assume you want the original file left in there so they can open it and create a new xlsx for the following day, but not create a file if it already exists (in case they open the xlsm twice in one day).
Another point to consider - is their personal folder given their name?
E.g. G:\MMS Trade Payables\John
I noticed in your code you set a variable thisWb to equal the ActiveWorkbook.
You could just use ThisWorkbook which always refers to the workbook that the code is running in.
So with these assumptions, try this code:
Sub Name_And_Save_Report()
Dim fName As String
Dim sNewFile As String
'Get the folder name.
fName = GetParentFolder(ThisWorkbook.Path)
'Could also get the Windows user name.
'fName = Environ("username")
'Or could get the Excel user name.
'fname = application.username
'Or could just ask them.
'fname = InputBox("Enter your name (example-John):")
sNewFile = ThisWorkbook.Path & Application.PathSeparator & _
fName & "_Manual Recon " & Format(Date, "mm.dd.yy") & ".xlsx"
If Not FileExists(sNewFile) Then
'Turn off alerts otherwise you'll get
'"The following features cannot be saved in macro-free workbooks...."
'51 in the SaveAs means save in XLSX format.
Application.DisplayAlerts = False
ThisWorkbook.SaveAs sNewFile, 51
Application.DisplayAlerts = True
End If
End Sub
Public Function FileExists(ByVal FileName As String) As Boolean
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
FileExists = oFSO.FileExists(FileName)
Set oFSO = Nothing
End Function
Public Function GetParentFolder(ByVal FilePath As String) As String
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
GetParentFolder = oFSO.GetFolder(FilePath).Name
Set oFSO = Nothing
End Function
I'll leave this here as my first answer:
Do you mean something like this?
Using the FileSystemObject to recursively get the parent folder name.
Sub Test()
MsgBox ThisWorkbook.Path & vbCr & RelativePath(ThisWorkbook.Path, 2)
'Will return "C:\Users\e6y550m" - step back 2 folders.
MsgBox RelativePath("C:\Users\e6y550m\Documents\MANUAL RECS\", 2)
'Your line of code:
'ActiveWorkbook.SaveAs FileName:=RelativePath(thisWb.Path, 2) & "\" & fname & "_Manual Recon" & " " & Format(Date, "MM.DD.YY") & ".xlsx"
End Sub
'FilePath - path to file, not including file name.
'GetParent - the number of folders in the path to go back to.
Public Function RelativePath(FilePath As String, Optional GetParent As Long) As String
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
'If rightmost character is "\" then we've reached the root: C:\
If GetParent = 0 Or Right(FilePath, 1) = Application.PathSeparator Then
RelativePath = oFSO.GetFolder(FilePath)
'If we've reached the root then remove the "\".
If Right(RelativePath, 1) = Application.PathSeparator Then
RelativePath = Left(RelativePath, Len(RelativePath) - 1)
End If
Else
'GetParent is greater than 0 so call the RelativePath function again with
'GetParent decreased by 1.
RelativePath = RelativePath(oFSO.GetParentFolderName(FilePath), GetParent - 1)
End If
Set oFSO = Nothing
End Function
I apologize if my question wasn't clear; I am a VBA novice at best.
'This is the current file that is already open,
Windows("Manual Reconciliation Template.xlsm").Activate
' I want to share this file with my teammates so they can use it. They all have different folders. I will place a copy of this workbook in each of their folders. When they use the copy that is in their personal folder, the macro needs to rename the workbook and save the renamed copy in their personal folder. The macro therefore needs code that will rename the workbook and save it in their folder without having a defined path. The shared drive path is G:\MMS Trade Payables. Within the MMS Trade Payables folder are the personal folders. I think the code just needs to activate the current workbook that is already open, rename it and save it in the current folder as an .xlsx instead of an .xlsm.
Current code:
Sub Name_And_Save_Report()
'
' TO NAME, DATE AND SAVE THE REPORT AFTER IT HAS BEEN WORKED.
'
Windows("Manual Reconciliation Template.xlsm").Activate
Dim thisWb As Workbook
Dim fname
' Will use the fname variable to add the associates name to the file name (ex:If the associate enters Mark into the inputbox, fname will = Mark).
fname = InputBox("Enter your name (example-John):")
' Makes thisWb = "Manual Reconciliation Template.xlsm".
Set thisWb = ActiveWorkbook
Workbooks.Add
' Saves the active workbook ("Manual Reconciliation Template.xlsm") to the path of thisWb and renames the workbook by adding the fname value and the current date (ex: if the associate entered Mark as the value of fname, "Manual Reconciliation Template.xlsm" becomes "Mark_Manual Recon 7.14.17.xlsx").
ActiveWorkbook.SaveAs FileName:=thisWb.Path & "\" & fname & "_Manual Recon" & " " & Format(Date, "MM.DD.YY") & ".xlsx"
' Closes the renamed workbook.
ActiveWorkbook.Close savechanges:=False
' Calls the original workbook and closes it.
Windows("Manual Reconciliation Template.xlsm").Activate
ActiveWorkbook.Close savechanges:=False
End Sub
Of course, this could be completely wrong since I am new to VBA.
I am using a workbook that generates reports according to the country selected. Each country uses an specific path directory.
When it comes to import information form their root folder its OK.
My problem is when I generate a new workbook with the report. I try to save it in the specific location which changes with the country:
'Generate a new workbook refering to the first Worksheet
Set WkReport = Workbooks.Add(xlWBATWorksheet)
With WkReport
// Skip selecting the sheet, just reference it explicitly and copy it after//
// the blank sheet in the new wb.
ThisWorkbook.Worksheets("REPORT").Copy after:=.Worksheets(.Worksheets.Count)
End With
// Kill alerts, delete the blank sheet in the new wb and turn alerts back on//
Application.DisplayAlerts = False
With WkReport
.SaveAs Filename:="L:\Fold1\Fold2\Fold3\" & rngFolder & "\" & rngYear & "\" & rngMonth &"\"& rngName & "_Report_" & rngDate & ".xlsx"
End With
Application.DisplayAlerts = True'`enter code here`
L:\Fold1\Fold2\Fold3: fixed path
rngFolder is the Path for the Country
rngYear is the Path for a subfolder within Country
rngMonth is the Path for a subfolder within the Year
(rngSmthing are ranges referring to cells in the workbook)
All those are dynamics ranges that changes according to information introduced by the user.
Therefore when I create the workbook it must be saved in different location according to this information.
Name of the file contains another dynamic range "rngName" followed up by Report and "rngDate":
Filename = rngName_Report_rngDate.xlsx
What my code does is to save in L:\Fold1\Fold2\Fold3 with the filename Report.xlsx
Examples of Path directories if user selects...
Germany:
L:Folder1\Folder2\Folder3\Germany\2015\06-2015\GE_Report_31-06-15.xlsx
Hungary:
L:Folder1\Folder2\Folder3\Hungary\2015\06_2015\HU_Report_31-06-15.xlsx
!PROBLEM SOLVED! I simply forgot to set the rngSmthng Variables... (Clap Clap) Anyway, someone may find it useful in case that you want to set different save paths according to your ranges:
'cellRef is a named cell within the workbook where user selects data
rngName = ws.Range("cellRef").Value
In that way you have a dynamic path finder.
Glad you found the answer. As a side-note - this is how I would write the procedure.
Sub Test()
Dim wkReport As Workbook
Dim sFolder As String
Dim sPath As String
Dim rngFolder As Range
Dim rngName As Range
With ThisWorkbook.Worksheets("Sheet1")
Set rngFolder = .Range("A1")
Set rngName = .Range("A2")
End With
sFolder = "L:\Fold1\Fold2\Fold3\" & rngFolder & "\" & Format(Date, "yyyy\\mm mmm\\")
CreateFolder sFolder
sPath = sFolder & rngName & "_Report_" & Format(Date, "dd-mm-yy") & ".xlsx"
Set wkReport = Workbooks.Add(xlWBATWorksheet)
With wkReport
ThisWorkbook.Worksheets("REPORT").Copy after:=.Worksheets(.Worksheets.Count)
.Worksheets(1).Delete
.SaveAs sPath, ThisWorkbook.FileFormat
End With
End Sub
' Purpose : Will Recursively Build A Directory Tree
Sub CreateFolder(Folder)
On Error Resume Next
Dim objFSO As Object: Set objFSO = CreateObject("Scripting.FileSystemObject")
If Folder <> "" Then
If Not objFSO.FileExists(objFSO.GetParentFolderName(Folder)) Then
Call CreateFolder(objFSO.GetParentFolderName(Folder))
End If
objFSO.CreateFolder (Folder)
End If
End Sub
Note:
Format(Date, "yyyy\\mm mmm\\") will return 2015\12 Dec\.
Format(Date, "yyyy\mm mmm\") will return 2015m12 Dec.
Really sorry guys...
And many thanks for your help... no way you could have guessed it.
The problem was that those variables I have them set in a different macro, which I completely forgot... so of course it does not recognize the variables.. because I didnt create them in this Macro!!
Again my apologies should review my code twice before posting
I'm starting a new project and having trouble right at the start =[. So often I need to pull out specific data from a very large excel sheet and create a new excel sheet for just that data. At the moment I am currently trying to create a new workbook and save it to a file path. I am getting the error on the SaveAs execution line. Any idea why this might be happening? The error is:
"Method 'Save As' of object' _Workbook' failed.
Dim Path As String
Dim dat As String
Dim Client As String
Path = "C:\Back\Test\"
ThisWorkbook.Sheets("Control Panel").Activate
dat = Range("F42")
Client = Range("F43")
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=Path & Date & "-" & Client & ".xls", FileFormat:=xlNormal
newWBName = ActiveWorkbook.Name
I will propose my access to your need.
Here is sub which should do what you need. So first i recomend to Dim all of your variables and do not use activate. Instead use sheet variable and also acces single values via cells not via range.
But your main issue maybe is that you try to use reserved word Date. Let me know if something isnt clear to you.
Sub save()
Dim filePath As String
Dim dateFromSheet As String
Dim clientName As String
Dim controlPanelSheet As Worksheet
Dim newWorkbookName As String
Set controlPanelSheet = Sheets("Control Panel")
filePath = "c:\Users\sukl\Documents\"
With controlPanelSheet
dateFromSheet = .Cells(42, "F").Value
clientName = .Cells(43, "F").Value
End With
ThisWorkbook.SaveAs Filename:=filePath & dateFromSheet & "-" & clientName & ".xls", FileFormat:=xlNormal
newWorkbookName = ThisWorkbook.Name
End Sub
I recorded vba code to do some conditional formatting. The result is stored in the workbook itself. Now I want to force the user not to save the workbook, instead after the code is run, it should automatically save the workbook using "Save As" into a non macro file using some unique identifier such as "yyyymmmdd, hhmm.xlsx" and it should also ask the user where to save.
Additionally, it should close the workbook without saving it and open the last saved as .xlsx file. I found some codes, but they are not exactly what I am looking for. Please help.
How about this
Option Explicit
Sub SaveAs()
Dim sDate As String
Dim FileName As String
'// format Date
sDate = Format(Now, "YYYYMMDD HHMM")
'// Save As Name
FileName = sDate
'// Save path
Application.Dialogs(xlDialogSaveAs).Show FileName
End Sub
add this code below your code
Per OP Comment
This should do it - Tested on Excel 2010
Option Explicit
Sub SaveAs()
Dim xlSaveAs As String
Dim xlPath As Variant
Application.ScreenUpdating = False
'// Save As Name
xlSaveAs = "Weekly Report - " & Format(Now, "YYYYMMDD HHMM") & ".xlsx"
'// Save path
Application.DisplayAlerts = False
xlPath = Application.GetSaveAsFilename( _
InitialFileName:=xlSaveAs, _
FileFilter:="Excel Files (*.xlsx), *.xlsx", _
Title:="My Save Dialog")
If xlPath <> False Then
ThisWorkbook.SaveAs xlPath, xlOpenXMLWorkbook
Else
MsgBox "Not Valid Path" '// Cancel
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Finally, You may find the Getting Started with VBA in Office 2010 article in MSDN helpful.
edit : I rewrite the code to do what you want
Public Sub SaveNewFile()
' Create a new file basing the name of the current file (without extension if it's an xlsm) and the creation time
Dim filename As String
filename = ThisWorkbook.Path & "\" & CreateObject("scripting.filesystemobject").getbasename(ThisWorkbook.Name) & Format(Now, "yyyyMMdd hhmm") & ".xlsx"
' Save the file under the new name in xlsx format
' This action close the file and reopen it with the new name
Application.DisplayAlerts = False
ThisWorkbook.SaveAs filename:=filename, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
End Sub
I am working on creating excel file, that includes only button that, when clicked on, extracts all other excel files in specified (now just hardcoded) directory into pipe delimited .txt files. I did some programming in the past but I am not familiar much with VBA, so I usually work by searching and reusing tutorials and such.
Basicaly what I want to do is:
- Loop through specific directory
- For each xls/xlsx file, create separate .txt pipe delimited extract of the same name with .txt extension
So far, I got to this code:
Sub Run_Coversion()
Dim directory As String
Dim fileName As String
Dim OutputFile As String
Dim myWkBook As Workbook
Dim myRecord As Range
Dim myField As Range
Dim nFileNum As Long
Dim sOut As String
Const DELIMITER As String = "|"
Application.ScreenUpdating = False
directory = "C:\Users\vacek\Documents\EFPIA_Project\Excel_Tool\Files\"
fileName = Dir(directory & "*.xls*")
Do While fileName <> ""
Workbooks.Open (directory & fileName)
OutputFile = directory & fileName & ".txt"
nFileNum = FreeFile
Open OutputFile For Output As #1
Set myWkBook = Workbooks(fileName)
myWkBook.Sheets("Sheet1").Activate
For Each myRecord In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
With myRecord
For Each myField In Range(.Cells, Cells(.Row, Columns.Count).End(xlToLeft))
sOut = sOut & DELIMITER & myField.Text
Next myField
Print #nFileNum, Mid(sOut, 2)
sOut = Empty
End With
Next myRecord
End With
Workbooks(fileName).Close
fileName = Dir()
Loop
Application.ScreenUpdating = True
End Sub
The problem is, that the "For each" loop goes through workbook that is running the macro, not the one, that is opened. I experimented with setting active of that workbook, but I cannot make it working. Can anyone help me to set this right?
Dim Sheet1 as Object
Set Sheet1 = [Object].Application.Workbooks("filename").WorkSheets("Sheet1")
you can do it like this also
I needed to do something similar, though in my case the delimiter in question was > and I was importing a .txt file as if it were a .csv.
I used the Workbooks.OpenText method, with the parameter DataType:=xlDelimited. To set a delimiter other than tab or comma or semicolon, I set the Other and OtherChar parameters to Other:=True, OtherChar:=">".
This worked for me; perhaps it will work just as well for OtherChar:="|"?
Create a reference to the worksheet in the opened workbook:
Dim sheet As Worksheet
Set sheet = myWkBook.Sheets("Sheet1")
Then use that variables Range/Row/Cell ... properties in the subsequent code to prevent a "naked" Range defaulting to the ActiveWorkbook:
For Each myRecord In sheet.Range("A1:A" & sheet.Range("A" & sheet.Rows.Count).End(xlUp).Row)
...