Run-Time Error '9': Subscript Out of Range when generating spreadsheet - excel

I am currently trying to use an access database which uses vba to generate Excel spreadsheets and AutoCAD drawings; I didn't write the code, and I don't have experience coding in this language. When generating an excel file, the code gets to the line MyXL.Parent.Windows(1).Visible = True, it gives the error. The excel file is generated, but is identical to the template.
The File and directory names are placeholders
Dim MyXL As Object
FileCopy "\Directory\Template", "\Directory\Filename"
' This copies an Excel file, first half, then renames it with the Sales order number
Set MyXL = GetObject("\Directory\Template")
' This opens the Excel file named in the upper code second half
MyXL.Application.Visible = True
MyXL.Application.WindowState = 3
' MyXL1.Activate
MyXL.Parent.Windows(1).Visible = True
MyXL.Parent.ActiveWindow.WindowState = 2
With MyXL.Worksheets(1)
End With
At this point it sets a lot of values (I assume) in the form .Range("T60").Value = Me![Text516]
MyXL.Worksheets(1).Activate
MyXL.Save
MyXL.Parent.Quit ' This is what you have to do to close the Application
'MyXL.Parent.Quit
' MyXL.Parent.ActiveWindow.WindowState = xlMinimized
' MyXL.Close
The possible duplicate relates to copying an excel spreadsheet, however this problem goes further than that
Edit: I made a mistake and previously had the line Set MyXL = GetObject("\SameDirectory\SameFilename") but it is actually Set MyXL = GetObject("\Directory\Template")

Example of working code to open an Excel workbook, edit, save to a new name.
Sub CopyExcel()
Dim xl As Excel.Application, xlw As Excel.Workbook
Set xl = CreateObject("Excel.Application")
'the following two lines have same result
Set xlw = xl.Workbooks.Open("C:\Users\June\MyStuff\Condos.xlsx", , True)
'Set xlw1 = xl.Workbooks.Add("C:\Users\June\MyStuff\Condos.xlsx")
'code to edit
xlw.SaveAs "C:\Users\June\MyStuff\Condos2.xlsx"
xl.Quit
End Sub

Related

I can't update worksheets objects links on powerpoint VBA - OneDrive Folder

I've already read in the forums but noone has my exactly problem, so here we go.
I have my excel and powerpoint files in a OneDrive folder (the Powerpoint is in subfolder), the powerpoint has 100 links.
So, in a forum someone suggested that to get the local OneDrive path, you should turn off the process. I did it.
I have to have the excel file open, because the processing time is really slow if the excel is closed. So If I have opened the excel file and run the macro (in other folder diferent to OneDrive) it runs ok, but if I try to do the same but in the OneDrive folder, it generated the next error into the code line pptShape.LinkFormat.Update:
Error -2147188160 (80048240) in runtime. LinkFormat (unknown member):
Invalid request. The linked file was unavailable and could not be
updated
If I have the excel file closed, the macro runs ok, but the process is so slow (almost 30 minuts), because it open and close the excel a hundred times.
does anyone knows why it happened? How can I fix it? I'll appreaciate your help. here is the code to update the links
Sub updatelinks_1()
Call Shell("cmd.exe /S /C" & "%LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /shutdown")
Application.DisplayAlerts = ppAlertsNone
Dim pptPresentation As Presentation
Dim pptSlide As Slide
Dim pptShape As Shape
'Set the variable to the PowerPoint Presentation
Set pptPresentation = ActivePresentation
'Loop through each slide in the presentation
For Each pptSlide In pptPresentation.Slides
'Loop through each shape in each slide
For Each pptShape In pptSlide.Shapes
'Find out if the shape is a linked object or a linked picture
If pptShape.Type = msoLinkedOLEObject Then
Dim name, path1, path2, source, begin, search1, cells As String
Dim limit1 As Integer
name = pptShape.LinkFormat.SourceFullName
limit1 = InStr(1, name, "!")
cells = Right(name, Len(name) - limit1)
search1 = "subfoldername"
path1 = Application.ActivePresentation.FullName
begin = InStr(1, path1, search1)
begin = Left(path1, begin - 1)
file1 = Dir(begin & "*.xlsm")
source = begin & file1
End If
path2 = source & "!" & cells
pptShape.LinkFormat.SourceFullName = path2
'update method. code line where generate error
pptShape.LinkFormat.Update
End If
Next
Next
'Update the links (If I use this method on OneDrive folder, it doesn't work and broke all the links because replace the Link name with only the excel file name, not the sheets and cells)
' pptPresentation.UpdateLinks
Call Shell("cmd.exe /S /C" & "start %LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /background")
Set pptPresentation = Nothing
Set pptSlide = Nothing
Set pptShape = Nothing
Application.DisplayAlerts = ppAlertsAll
End Sub
Good morning everyone.
As I have not seen the solution, I'd like to add my 2 cents.
I have had a similar issue, on a win10 Platform running Office 365.
In my case both files are on the same laptop.
I have seen that the powerpoint VBA procedure to update the path takes a long time by default. ( around 4 Minutes for me as there are 22 linked Objects).
One can speed it up by manually open the target excel file before launching the Powerpoint VBA.
It becomes effectively faster but I hit the issue where for each link the ppt vba procedure tries to update, we get a pop up window telling us that Excel can't open 2 files with same name.
I've tried to add in the PowerPoint VBA procedure : Application.DisplayAlerts = False , but is logically inefficient as applies to the PPT application and not to the Excel app !
I finally found one quick (and logic) solution :
at the beginning of the PowerPoint VBA, I ask user to locate the target excel file :
Set XlApp = CreateObject("Excel.Application")
ExcelFile = XlApp.GetOpenFilename(, , "Would you please locate your excel File")
And after, I just Open the target file, and set it with displayLAerts to False.
XlApp.Visible = True
Set xlWorkbook = XlApp.Workbooks.Open(ExcelFile, True, False)
Doing so, I no longer get warnings.
Full source code available .
Wish you a nice day !

Need to color the header in excel from SSIS package

Requirement: I need to export data from a query to formatted excel sheet using SSIS. Currently working with .xls
What I tried: I used an excel sheet with pre-formatted header row (first row) as template and I copy and rename to a new file to export data. When I run the package, all data rows will have the same formatting as the header. I tried googling only to find many people having the same issue.
Now I am writing to a non-header formatted excel sheet and using a script task, I am trying to format the headers alone. Below is the code
Dim appexcel As Microsoft.Office.Interop.Excel.Application = New Microsoft.Office.Interop.Excel.Application()
Dim newbook As Workbook
Dim sheet As Object
Dim Connection As String = "..My path\\All_Current.xls" '
newbook = appexcel.Workbooks.Open(Connection)
sheet = newbook.Worksheets("REPORT")
Dim selectedSheet As Worksheet = DirectCast(sheet, Worksheet)
'Dim style As Style = selectedSheet.Application.ActiveWorkbook.Styles.Add("ColorStyle")
selectedSheet.Cells.Range("A1", "I1").Interior.Color = System.Drawing.Color.LightBlue
'selectedSheet.Cells.Range("A1", "I1").Font.Color = System.Drawing.Color.White
'selectedSheet.Cells.Range("A1", "I1").Font.FontStyle = "Bold"
'selectedSheet.Cells.Range("A1", "I1").Font.Name = "Verdana"
'selectedSheet.Cells.Range("A1", "I1").Font.Size = 10
newbook.Save() ' This line the compiler runs forever
newbook.Close(False)
appexcel.Quit()
Dts.TaskResult = ScriptResults.Success
I am unable to check if my code is working or not. If I debug, it keeps running at the '.save()' line. Any help would be appreciated.
I got this to work with the below code
'newbook.Save()
appexcel.ActiveWorkbook.CheckCompatibility = False ' to prevent compatibility check dialog showing
appexcel.ActiveWorkbook.Save() ' saves only this workbook
newbook.Close(False)
appexcel.Quit()

Read live Values from one Excel Workbook to another Workbook while opened

I would like to be able to read and write values using VBA from one OPEN Excel workbook to another application without using the "as worksheet" function due to this being a non-windows application. Is this possible?
The code I've posted is from a PLC application using scripting.
I just need to know what function to use besides .open since the file is already opened.
Dim objXLApp, objXLWb, objXLWs1, objXLWs2, objXLWs5
Set objXLApp = CreateObject("Excel.Application")
objXLApp.Visible = True
Set objXLWb = objXLApp.Workbooks.Open("File.xlsm")
'~~> Working with Sheet1
Set objXLWs1 = objXLWb.Sheets(1)
Set objXLWs2 = objXLWb.Sheets(2)
Set objXLWs5 = objXLWb.Sheets(5)
'~~>Write SetPoints to Sheet1
With objXLWs1
'~~>Write
.Cells(6,23).value = SmartTags("Job Time Sec to OEE")
.Cells(6,23).value = SmartTags("Run Time Sec to OEE")
End With
''~~>Write Setup Values to Sheet2
'~~> Save as Excel File (xls) to retain format
objXLWb.Save
objXLWb.Close (False)
Set objXLWs1 = Nothing
Set objXLWs2 = Nothing
Set objXLWs5 = Nothing
Set objXLWb = Nothing
objXLApp.Quit
Set objXLApp = Nothing
If the workbook is already open you can just refer to it by name as part of the Workbooks collection.
Set objXLWb = objXLApp.Workbooks("File.xlsm")
Edit: Since you have changed your question I'm no longer certain what you're asking. My guess is that your 'already open' workbook isn't open in the same Excel instance you're creating with Set objXLApp = CreateObject("Excel.Application"), so you'll need a reference to the existing Excel application, then the open workbook within that application.

VB Script to copy all sheet data one excel to another excel sheet

Is it possible to copy data from all the workbook sheets from one excel sheet (ex: A.xls) to another existing excel (ex: B.xls).
Can a logic be implemented, using VB, where it can do that no matter the amount of workbook sheets in A.xls (i.e. It should copy all the data of all pages of A.xls to B.xls)
I appreciate any kind of help, for I am not from a programming background.
Though I'm starting to think you want to copy all the data across many tabs to one tab, if you actually want to keep the data on separate tabs, you can use something like this to loop through the worksheets in A.xlsx and copy them to B.xlsx:
Sub copy_sheets()
Dim eapp As Excel.Application
Dim wkbk_from As Workbook
Dim wkbk_to As Workbook
Dim wksh As Worksheet
Set eapp = CreateObject("Excel.Application")
Set wkbk_from = eapp.Workbooks.Open("C:\Documents\Miscellaneous-DT\Excel\a.xlsx")
Set wkbk_to = eapp.Workbooks.Open("C:\Documents\Miscellaneous-DT\Excel\b.xlsx")
eapp.Visible = True
For Each wksh In wkbk_from.Worksheets
wksh.Copy After:=wkbk_to.Worksheets(Worksheets.Count)
Next wksh
End Sub
Well After a lot of struggle and learning some basics i was able to get the code
Here is the code which works
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objPasteData = objExcel.Workbooks.Open("C:\A.xlsx") 'Copy From File
Set objRawData= objExcel.Workbooks.Open("C:\B.xls") 'Paste To File
Set obj1 = objPasteData.WorkSheets("RawData") 'Worksheet to be cleared
obj1.Cells.Clear
countSheet = objRawData.Sheets.Count
For i = 1 to countSheet
objRawData.Activate
name = objRawData.Sheets(i).Name
objRawData.WorkSheets(name).Select
objRawData.Worksheets(name).Range("A2").Select
objExcel.ActiveSheet.UsedRange.Select
usedRowCount1 = objExcel.Selection.Rows.Count
objExcel.Range("A2:H" & usedRowCount1).Copy
objPasteData.Activate
objPasteData.WorkSheets("RawData").Select
objExcel.ActiveSheet.UsedRange.Select
usedRowCount2= objExcel.Selection.Rows.Count
objPasteData.Worksheets("RawData").Range("A"& usedRowCount2 + 1 ).PasteSpecial Paste =xlValues
Next
objPasteData.Save
Thanks #Nilpo & #rryanp for guidance.
The easiest way to copy all data from one worksheet to another is to use the copy and paste operation on a range that consists of all filled cells.
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkbook1= objExcel.Workbooks.Open("C:\test1.xls")
Set objWorkbook2= objExcel.Workbooks.Open("C:\test2.xls")
Set objRange = objWorkbook1.Worksheets("Sheet1").UsedRange.Copy
objWorkbook2.Worksheets("Sheet1").Range("A1").PasteSpecial objRange
objWorkbook1.Save
objWorkbook1.Close
objWorkbook2.Save
objWorkbook2.Close
You say existing file b.xls, wbut if you overwrite everything, it doesn't matter so why not use
CreateObject("Scripting.FileSystemObject").CopyFile "a.xls", "b.xls", true
I had the same task yesterday and had to spent a lot of time searching for the parts of the solution. From some reason in vbs named constants are not available (at least in newer Excel versions).
The script below is tested and prooved to be working in newer Excel (2016)
outputFiletype = 51 'type_xlsx
' I assume you want to use the script for different files, so you can pass the name as a parameter
If Wscript.Arguments.Count < 1 Then
Wscript.Echo "Please specify a name of the Excel spreadsheet to process"
Else
inputFilename = Wscript.Arguments(0)
outputFilename = Replace(inputFilename, ".xlsx", "_calc.xlsx")
Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False
' if you want to make the excel visible (otherwise if it is failed it will hang in a process list)
'objExcel.Application.Visible = True
Set currentWorkbook = objExcel.Workbooks.Open(inputFilename)
Set newWorkbook = objExcel.Workbooks.Add()
i = 0
For Each current_sheet In currentWorkbook.Worksheets
If current_sheet.Visible Then ' copying only the visible ones
i = i + 1
Dim new_sheet
If newWorkbook.Sheets.Count < i Then
newWorkbook.Sheets.Add , newWorkbook.Sheets(i-1) ' after the last one
End If
Set new_sheet = newWorkbook.Sheets(i)
new_sheet.Name = current_sheet.Name
current_sheet.UsedRange.Copy
new_sheet.Select
new_sheet.UsedRange.PasteSpecial 13 'xlPasteAllUsingSourceTheme - Everything will be pasted using the source theme
new_sheet.UsedRange.PasteSpecial 8 'xlPasteColumnWidths - Copied column width is pasted
new_sheet.UsedRange.PasteSpecial 12 'xlPasteValuesAndNumberFormats - Values and Number formats are pasted.
End If
Next
newWorkbook.SaveAs outputFilename, outputFiletype
currentWorkbook.Close False
newWorkbook.Close False
objExcel.Quit
End If

Best way to read an Excel file into an Access database

What's the "best" way to read (just read) an Excel file from within an Access 2007 application. I only want to loop trough the rows and put the data into an Access table.
I don't want a manually import (Get External Data dialog) but by VBA. The user gets a Form with a Browse button and then points to a Excel file with a defined content/format. After that the VBA code reads the data and puts it into the Access database.
You could try the DoCmd.TransferSpreadsheet method.
DoCmd.TransferSpreadsheet acImport, , "from_excel","C:\Access\demo.xls", True
That imports spreadsheet data into a table named from_excel, and assumes the first row of the spreadsheet contains field names. See Access help for TransferSpreadsheet or online here, for more details.
If you want to read the entire spreadsheet in, you can import an Excel spreadsheet directly into Access. See here or here.
You can also choose to link to the Excel spreadsheet instead of importing it. That way any changes to the Excel spreadsheet will be reflected in the linked table. However, you won't be able to make changes from within Access.
A third option is to write some VBA code within Access to open a recordset and read the spreadsheet in. See the answers from KeithG in this thread. You can do something like this to open the spreadsheet in VBA:
Dim xl As Excel.Application
Dim xlsht As Excel.Worksheet
Dim xlWrkBk As Excel.Workbook
Set xl = CreateObject("Excel.Application")
Set xlWrkBk = GetObject("H:/ggg.xls")
Set xlsht = xlWrkBk.Worksheets(1)
Try something like this:
Dim excelApp As Excel.Application
Dim workbook As Excel.Workbook
Dim worksheet As Excel.Worksheet
Set excelApp = CreateObject("Excel.application")
Set workbook = excelApp.Open("C:\someFileName.xls")
Set worksheet = workbook.Worksheets(1)
And then loop through the rows and columns, pull the data from the cells, and insert it into the database. (You can use the worksheet.cells method.) Try searching on google for code samples.
Hereafter my method to read an excel file and all the worksheet names:
Function listOfWorksheet(filename As String) As Collection
Set dbExcel = OpenDatabase(filename, False, True, "excel 8.0")
For Each TableDef In dbExcel.TableDefs
Debug.Print TableDef.Name
Next
End Function
Now, you can use the name of the worksheet to read the whole content:
Function ReadMyObjects(filename as String, wsName as String) As Collection
On Error GoTo label_error
Set results = New Collection
Dim countRows As Integer
Set dbExcel = OpenDatabase(filename, False, True, "excel 8.0")
Set excelRs = dbExcel.OpenRecordset(wsName, dbOpenSnapshot)
Do While Not excelRs.EOF
'Data Rows
Dim item As MyObject 'a custom object defined by you.
Set item = New MyObject
item.ABC = Nz(excelRs.Fields("COLUMN_ABC").Value, "")
item.DEF = Nz(excelRs.Fields("COLUMN_DEF").Value, "")
results.Add item
excelRs.MoveNext
Loop
excelRs.Close
Set ReadMyObjects= results
GoTo label_exit
label_error:
MsgBox "ReadMyObjects" & Err.Number & " " & Err.Description
label_exit:
End Function

Resources