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
Related
I have a Datepicker written in vb.net that looks like this.
I had to do it this way because of some Security Settings we have. Because of that, the Build in Datepicker from Excel generate sometimes an Error.
The Date Picker works fine if there Is Only One Excel Application Open. The Problem is when there are Multiple Excel Applications Open.
The code only takes the first Excel Application, but I want to get the Excel Workbook that's called "Test".
I Think the problem is this statement:
objExcel = System.Runtime.InteropServices.Marshal.GetActiveObject("Excel.Application")
For a better understanding the Code from Excel and the DatePicker Application is below:
That's how I open the vb.net Application in Excel:
Set wsh = VBA.CreateObject("WScript.Shell")
arg = ActiveWorkbook.Path & ";" & ActiveWorkbook.Name & ";" & ActiveSheet.Name & ";" & Target.Address
' Wait for the shelled application to finish:
errorCode = wsh.Run(strPathDatePicker & " " & arg, windowStyle, waitOnReturn)
The code for the DatePciker is:
Public Sub frmDatePicker_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim Par() As String
Dim strTemp As String
Try
Dim arg = Environment.GetCommandLineArgs
strTemp = arg(1)
Par = Split(strTemp, ";")
'Split arg, to get the Information from the Excel Workbook
strWbPath = Par(0)
strWbName = Par(1)
strWsName = Par(2)
strAdresse = Par(3)
Catch ex As Exception
Me.Close()
End Try
End Sub
If you now click on a Date the vb.net Application will run this code for inserting the selected date into Excel:
Private Sub MonthCalendar1_DateSelected(sender As Object, e As DateRangeEventArgs) Handles MonthCalendar1.DateSelected
Dim objExcel As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Try
'Get the Excel Object
objExcel = System.Runtime.InteropServices.Marshal.GetActiveObject("Excel.Application")
For Each wb In objExcel.Workbooks
If wb.Name = strWbName Then
ws = wb.Sheets(strWsName)
ws.Range(strAdresse.ToString).Value = e.Start()
Me.Close()
End If
Next
Catch ex As Exception
MessageBox.Show(ex.Message)
Me.Close()
End Try
End Sub
The usual ways would probably be to pass the process Id, or Application.Hwnd, or even the risky ActiveWindow.Caption, but I think just the full external address is enough to find the Excel instance. For example in VB.Net (not tested):
Dim o As Object = GetObject("Book 1.xls")
Dim wb As Excel.Workbook = TryCast(o, Excel.Workbook)
Note that ; is valid character in file, workbook, worksheet, and named range names so I would recommend looking for a different separator. For example non-printable characters like Chr(0) might work, or just use the full external address Target.Address(,,,1).
Environment.GetCommandLineArgs(1) will cause problems if the argument contains spaces and is not surrounded by ": https://msdn.microsoft.com/en-us/library/system.environment.getcommandlineargs
Note: This is not the solution but I am posting it here to avoid long code in the comments (to improve readability). I will leave this answer here since the OP comment to this answer provides more information about his problem.
Maybe you should change:
arg = ActiveWorkbook.Path & ";" & ActiveWorkbook.Name & ";" & ActiveSheet.Name & ";" & Target.Address
to
arg = ThisWorkbook.Path & ";" & ThisWorkbook.Name & ";" & ActiveSheet.Name & ";" & Target.Address
At least you are referencing the workbook that's currently running the code and since you may have several workbooks open that could change the ActiveWorkbook as you are navigating between them.
HTH ;)
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've just finished writing a spiffy macro for automatically generating reports. It works well, but I need it to automatically name the spreadsheet according to the data in two cells.
Essentially, this macro creates a new spreadsheet, copies the information over to it, and creates the relevant pivot-tables which are required monthly.
As part of this I've created a dashboard for generating the report with instructions and a date range the report is to relate to. It currently creates the spreadsheet "NEW REPORT". Is there a way of creating the new spreadsheet and naming it something along the lines of "Report 01.01.15 to 01.02.15" automatically?
I've got the date range as two separate cells, and I'm aware I'll have to make sure the date range is one that will use allowed characters (I.E. 01.01.15 rather than 01/01/15) - am I right in saying there's a way of telling the user they've put the dates in with the incorrect separators?
Example
Option Explicit
Public Sub SaveAs()
Dim FilePath As String
FilePath = "D:\Temp"
Dim FileName As String
FileName = Sheets("Report").Range("A1").Text
ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
To save it on today's date
Dim sSave As String
sSave = "Reports " & Format(Date, "dd-mm-yyyy")
Or tomorrow Date
"Reports" & Format(Date + 1, "dd-mm-yyyy")
For File Format See Examples
ThisWorkbook.SaveAs Filename:=FilePath, fileformat:=52
These are the main file formats in Excel 2007-2013
51 = xlOpenXMLWorkbook (without macro's in 2007-2013, xlsx)
52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2013, xlsm)
50 = xlExcel12 (Excel Binary Workbook in 2007-2013 with or without macro's, xlsb)
56 = xlExcel8 (97-2003 format in Excel 2007-2013, xls)
*Or maybe you want to save the one worksheet workbook to csv, txt or prn.*
".csv": FileFormatNum = 6
".txt": FileFormatNum = -4158
".prn": FileFormatNum = 36
To Save only one Sheet as new Workbook then you need to copy the sheet before saving it
Option Explicit
Sub SaveAs()
Dim Sht As Worksheet
Dim FileName As String
Dim FilePath As String
FilePath = "C:\Temp"
FileName = Sheets("Sheet1").Range("A1").Text
Set Sht = ActiveWorkbook.Sheets("Sheet1")
Sht.Copy
ActiveWorkbook.SaveAs FileName:=FilePath & "\" & FileName
End Sub
To Save Multiple sheets as new Workbook then use Sheets(Array("Sheet1", "Sheet2")).Copy
Option Explicit
Sub SaveAs()
Dim Sht As Worksheet
Dim Book As Workbook
Dim FileName As String
Dim FilePath As String
FilePath = "C:\Temp"
FileName = Sheets("Sheet1").Range("A1").Text
Set Book = ActiveWorkbook
With Book
.Sheets(Array("Sheet1", "Sheet2")).Copy
End With
ActiveWorkbook.SaveAs FileName:=FilePath & "\" & FileName
End Sub
I am looking for a way to return the value from an arbitrary workbook (the workbook will also not be open at the time of running the UDF), defined based on calculations in the UDF.
Pseudo code:
Start by calling =someFunc(currentCell) in any cell
Function someFunc(adr As Range)
region_eval = "C" & Range(adr).Row ' where column C contains string entries, all of which have a corresponding sub-dir (see fileReference).
networkLocation = ActiveWorkbook.Path
networkPath = networkLocation & "\Locations\"
fileReference = networkPath & region_eval & "\ProductList.xlsx"
Workbook.Open fileReference readonly
Perform index/match call against some sheet in this workbook
someFunc = returned value
Close workbook and end function
This is the desired behavior.
The logic to return the desired values is OK, I have tried it in a simpler formula, and in a UDF that relies on the file being opened manually:
INDEX(locationlist_$A$5000, MATCH(masterlist_A1, locationlist_$B$5000))
I have, after hours of hair-pulling, discovered that this functionality is not directly available in a UDF designed to work on workbooks that aren't opened manually, and that this is intended from Microsoft's side. But I have also discovered that there is a possible workaround!
Ref:
1. https://stackoverflow.com/a/27844592/4604845
2. http://numbermonger.com/2012/02/11/excel-pull-function-creating-dynamic-links-to-closed-workbooks/
These solutions require hardcoded file paths, which defeats the purpose for my intended usage.
Is there anyone who has insight about how to achieve what is achieved in any of the two above links, but with an arbitrary filepath (as in, contained in a cell neighbouring the cell where the UDF is being called from)?
Note: I tried doing the heavy lifting in a sub, and just call the sub as the first line in the UDF, set the result as a global var, and set the UDF return value to the same var after the sub finished, but either I crashed and burned pretty heavily or Excel saw through my trick and denied it.
EDIT:
Here's the sub/func combo.
Option Explicit
Public networkLocation As String, networkPath As String, fileReference As String, c_formula As String
Public sheet_src As Worksheet, sheet As Worksheet, wb_src As Workbook, wb As Workbook
Public region_eval As String, sheetName_src As String, sheetName As String, regionPath As String, fileName As String
Sub findProductStatus(adr As Range)
networkLocation = ActiveWorkbook.Path
networkPath = networkLocation & "\Locations\"
sheetName_src = "Sheet1"
sheetName = "Sheet1"
Set wb_src = ThisWorkbook
Set sheet_src = wb_src.Sheets(sheetName_src)
region_eval = Range("I" & adr.Row)
regionPath = networkPath & region_eval
'fileReference = regionPath & "\ProductList.xlsx"
fileName = "ProductList.xlsx"
ChDir regionPath
Workbooks.Open fileName:=fileName, ReadOnly:=True
'Set wb = Workbooks.Open(fileName:=ThisWorkbook.Path & "\Locations\Test\ProductList.xlsx", ReadOnly:=True)
Set wb = Workbooks("ProductList.xlsx")
Set sheet = wb.Sheets(sheetName)
c_formula = Application.WorksheetFunction.Index(sheet.Range("$K$2:$K$5000"), Application.WorksheetFunction.Match(sheet_src.Range("A" & adr.Row), sheet.Range("$A$2:$A$5000"), 0))
End Sub
Function getProductStatus(adr As Range) As String
Call findCourseStatus(adr)
getCourseStatus = c_formula
wb.Close
End Function
I haven't tested the sub/func combo against an open file, but when all of the code was inside the Function and the file in question was opened manually, it worked flawlessly. Stepping through the code and using Debug.Print, I see that even though "Workbooks.Open ..." goes through without any discernible error, the workbook doesn't actually get opened, and thus, when we try to use the workbook object to set the sheet, the function/sub terminates.
This can be achieved with a combination of a UDF() and an Event macro.
To retrieve data from a closed workbook, we need four things:
the path
the filename
the sheetname
the cell address
The only thing the UDF will do is to display these items in a very specific format:
Public Function someFunc() As String
Dim wbPath As String, wbName As String
Dim wsName As String, CellRef As String
Dim Ret As String
wbPath = "C:\TestFolder\"
wbName = "ABC.xls"
wsName = "xxx"
CellRef = "B9"
someFunc = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(CellRef).Address(True, True, -4150)
End Function
Take note of the position of the single quotes.
We then use a Calculate event macro to detect the UDF's execution and retrieve the data:
Private Sub Worksheet_Calculate()
Dim r1 As Range, r2 As Range
Set r1 = Range("C3")
Set r2 = Range("C4")
r2.Value = ExecuteExcel4Macro(r1.Value)
End Sub
The Calculate macro needs to know where the UDF is returning the string (C3) and it also needs to know where to put the retrieved data (C4).
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.