VBA Excel SaveAs works on one PC but corrupts file on another
I have written a MACRO that does what I need it to do and the end result is saving a file as
finished file and then open that file and run another MACRO.
This script works exactly as I need it to and there are no issues until I try to run this code on another computer.
Here is where the code breaks.
' Note I have tried several file formats. ocd_wb.SaveAs Filename:="finished file", FileFormat:=xlOpenXMLWorkbook Set re_wb = Workbooks.Open("finished file")
When I try the above on my Coworkers PC it errors out and when I check the file it is corrupt.
I am not sure what could cause this. Everything I check on the net say to save as various file type.
(52, xlOpenXMLWorkbook, xlOpenXMLWorkbookMacroEnabled). None of which work. Note that all of those formats work on my PC just fine so I am not sure it is an issue with the file type.
Update: We both have Office 2010 so its not a version issue.
See also questions close to this topic
Different pivot tables to different emails vba
I have multiple pivot tables that I want to send out individually to different emails. The problem is, the email keeps getting written over by the second email. Each pivot table is named different and the code works fine with only one reference. I have tried multiple ways to get it but cant. Can someone help?
Private Sub Workbook_Open() Dim wk As Worksheet Dim wk1 As Worksheet wk = Worksheets("EPSICAR") wk.Connections("owssvr").Refresh wk1 = Worksheets("PastDue") wk1.RefreshAll End Sub Sub pastdue() Dim myApp As Outlook.Application, mymail As Outlook.Mailitem Dim Lap As Object Dim rng As Range Dim rngmtl As Range Dim Mailitem As Object Set myApp = New Outlook.Application Set mymail = myApp.CreateItem(olMailItem) Set rng = Sheets("PastDue").PivotTables("Q Group Past Due").TableRange1 Set rngmtl = Sheets("PastDue").PivotTables("Mtl Group Past Due").TableRange2 With mymail .To = "email@example.com" .CC = "firstname.lastname@example.org" .Subject = "ICAR/EPS past due" .HTMLBody = "The following are a list of ICARs/EPS that are past due" & RangetoHTML(rng) .Display '.send With mymail .To = "email@example.com" .CC = "firstname.lastname@example.org" .Subject = "ICAR/EPS past due" .HTMLBody = "The following are a list of ICARs/EPS that are past due" & RangetoHTML(rngmtl) .Display '.send Set myApp = Nothing Set mymail = Nothing End With End With End Sub Function RangetoHTML(rng As Range) Dim fso As Object Dim ts As Object Dim TempFile As String Dim TempWB As Workbook TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" rng.Copy Set TempWB = Workbooks.Add(1) With TempWB.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial xlPasteValues, , False, False .Cells(1).PasteSpecial xlPasteFormats, , False, False .Cells(1).Select Application.CutCopyMode = False On Error Resume Next .DrawingObjects.Visible = True .DrawingObjects.Delete On Error GoTo 0 End With With TempWB.PublishObjects.Add( _ SourceType:=xlSourceRange, _ Filename:=TempFile, _ Sheet:=TempWB.Sheets(1).Name, _ Source:=TempWB.Sheets(1).UsedRange.Address, _ HtmlType:=xlHtmlStatic) .Publish (True) End With Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.ReadAll ts.Close RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _ "align=left x:publishsource=") TempWB.Close savechanges:=False Kill TempFile Set ts = Nothing Set fso = Nothing Set TempWB = Nothing End Function
How to open an access database from the VBA in a Word Macro
All is explained in the title.
I need to be able to run a macro in word that opens up an access database.
Better way to Vlookup
I would like to know if there is a better alternative to Vlookup to find matches between two cells (or Python Dfs).
I want my code to check if the values in DF1 was in DF2, If values exactly match OR if the values partially matche return me the value in the DF2.
Just like the matches in 4th column Row 2,3 returned values.
VBA: Delete Rows based on a column of cell values
Im still new to VBA. I would like to delete my data row based on a column of data from another sheet.
I have a sheet of data name: WorkingData Workingdata is a list of database with ProductIDs which is under Column A The productIDs would exist more than once because it is identified by period.
I have a external sheet name: IDs to exclude In the Sheets("IDs to exclude") under column A, there is a list of IDs to exclude because they are unclean data. However, every month the list will keep adding up so the range has to identify the last row.
Please and thank you!
How to find value in all sheets based on the user input and update the cell
I have a excel file with 142 sheets. All sheets have same table but different value but same ID. I want to update it so that, it can effect all the sheets that have the same ID.
Example I want to update value in the column title Efficiency for ID = 2.
I want to make a form in excel that have the text box that allow me to input the ID, input the column title and input the value that I want to update.
It will update all sheets according to the requirements.
Is this possible ?
Copy Chart from Excel to Word Bookmark
Apologies I am new to Visual Basic and I have been struggling with this for a while. I am trying to copy a chart from excel to a word document bookmark, but it just pastes the chart on the first paragraph of page 1.
I am wanting the chart to paste to a bookmark, Name = "Chart_Location", located at the beginning of page 2, of the word document. Any help would be greatly appreciated.
Method 'SaveAs' of object'_Workbook' faliled
The below code I have in 2 other files works fine but for some reason i am getting this SaveAs of ojbect error when it runs. What is even stranger is if i debug and just hit run again it completes with no error.
Sub saveWorksheet() Set report = ActiveWorkbook.Worksheets("Report") sb_Copy_Save_Worksheet_As_Workbook End Sub Sub sb_Copy_Save_Worksheet_As_Workbook() Dim wb As Workbook Set wb = Workbooks.Add ThisWorkbook.Sheets("Report").Copy Before:=wb.Sheets(1) wb.Sheets(1).Name = Day(Now) & "-" & MonthName(Month(Now), True) & "-" & Year(Now) & " " & getTime Application.DisplayAlerts = False wb.Sheets("Sheet1").Delete wb.SaveAs "\\Naeast.ad.jpmorganchase.com\amerawm$\AM\NAAMSHARE13\AM Oversight and control\DE Program Team\User Tools\14. Daily Trackers\Compliance Check Archive\" & Month(Date) & "-" & Day(Date) & "-" & Year(Date) & "-" & "New_Compliance_Check.xlsx" wb.Close Application.DisplayAlerts = True End Sub Function getTime() If Len(Time) = 10 Then getTime = Left(Time, 1) & "." & Mid(Time, 3, 2) Else getTime = Left(Time, 2) & "." & Mid(Time, 4, 2) End If End Function
The debug line that is highlighted is:
wb.SaveAs "\\Naeast.ad.jpmorganchase.com\amerawm$\AM\NAAMSHARE13\AM Oversight and control\DE Program Team\User Tools\14. Daily Trackers\Compliance Check Archive\" & Month(Date) & "-" & Day(Date) & "-" & Year(Date) & "-" & "New_Compliance_Check.xlsx"
Save As CSV Results Differently With VBA and Dialogue Box
I am trying to export an excel file as csv. However I do not want a comma seperated file.
When I use Save As dialogue box to save the file as .csv I have what I want as follows;
When I do the same procedure with record macro I have the following code;
ActiveWorkbook.SaveAs Filename:="C:\...path...\Kitap20.csv", _ FileFormat:=xlCSV, CreateBackup:=False ActiveWindow.Close
Since I want date record in the file name I do the following changes in the code (which works fine for the file name part);
ActiveWorkbook.SaveAs Filename:=strDesktopPath & "\my_file_" & DateF & ".csv", _ FileFormat:=xlCSV, CreateBackup:=False
Since I do not touch file format settings in the code, I expect to have the same output file, however, it creates a comma seperated file as follows;
Any help will be appreciated.
Save new file with filename cell value
I am working on making a universal production time sheet(
wbTime) for each dept that will work across all shifts and lines. I have where all the necessary information is required to be entered, all the data getting copied into a table in another workbook(
wbLog) and saved to be able to do analysis on the production data.
However, when it gets to trying to save the actual time sheet in the proper folder according to shift and machine line I start running into problems. I have it pulling part of the path from certain cells and the filename form the date the enter. It is getting to the last line and throwing a run-time error 1004 "Method 'SaveAs' of object_Worbook'failed".
I have only been playing with vba for 2 months so it is probably something small that I just do not see...
Sub TransferData() If ActiveSheet.Range("E2").Value = "" Then MsgBox "Operator Name Required", vbInformation, "ALERT: Missing Information" Cancel = True Exit Sub End If If ActiveSheet.Range("H2").Value = "" Then MsgBox "Date Required", vbInformation, "ALERT: Missing Information" Cancel = True Exit Sub End If If ActiveSheet.Range("K2").Value = "" Then MsgBox "Shift Required", vbInformation, "ALERT: Missing Information" Cancel = True Exit Sub End If If ActiveSheet.Range("M2").Value = "" Then MsgBox "Line Required", vbInformation, "ALERT: Missing Information" Cancel = True Exit Sub End If Dim wbTime As Workbook Set wbTime = ThisWorkbook Dim wbData As Workbook Dim LastRow As Long Set wbTime = ActiveWorkbook With wbTime.Sheets("Production Time Sheet") LastRow = .Range("E" & .Rows.Count).End(xlUp).Row End With wbTime.Sheets("Production Time Sheet").Range("A6:R" & LastRow).Copy Set wbData = Workbooks.Open("S:\Lean Carrollton Initiative\Michael\Time Sheet Data LT Test.xlsm") Set wbData = ActiveWorkbook wbData.Worksheets("Log").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues wbData.Close SaveChanges:=True Dim Fname As String Dim Path As String Dim shft As String Dim Line As String Set wbTime = ActiveWorkbook Fname = Sheets("Production Time Sheet").Range("I2").Text shft = Sheets("Production Time Sheet").Range("Z9").Text Line = Sheets("Production Time Sheet").Range("AC11").Text Path = "K:\Groups\OFS Time Sheets\8hr Production Schedule\LT Jacketing\" & shft & Line & Fname & ".xlsx" ActiveWorkbook.SaveAs filename:=Path, FileFormat:=xlNormal End Sub