| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code corrupts file (XL2003)
Additional note: I appended ".xls" to the filename in the code , but testing
still results in corrupt output file(s). "ker_01" wrote: I have code (below) that opens and processes a separate raw data file, segregates data into several different worksheets in that data file, then saves the file. I just found out that my code appears to corrupt the output files, which then cannot be opened in Excel2003, but can be opened in Excel2007. I can open *other* Excel files without a problem, but files created with this sub are corrupt. I suspect that it has to do with how the file is saved, so I'm posting just that snippet first, then the full code underneath. Should I be more restrictive in the Filefilter parameter? Or do I need to forceably add the ".xls" extension even though the save dialogue shows it to be saving as an XLS file? The file does save with the xls extension, and looks like an XL file in windows explorer (opens in Excel2003 when double clicked, but then throws an 'unrecognizable format' error, and shows a worksheet filled with ASCII characters). Any advice or suggestions would be greatly appreciated. Snippet: DirectorySetPath ("\\wsak1\Perf\Score\Ops\Public\CurrentData") new2fn = Application.GetSaveAsFilename( _ InitialFileName:="2010 USA Ops Salary Increases - " & PasteMonthNum & " " & StrMonth, _ FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", _ Title:=TitleString) ActiveWorkbook.SaveAs Filename:=new2fn Full code: Sub MakeReferenceWkbk() 'default start path, editable by user from the filepicker dialogue PathOnly = "\\wsak1\Perf\Score\Ops\People\Increases" Dim I As Integer Dim owb As Workbook 'original/main Dim twb As Workbook 'temp/data file Dim ows As Worksheet Dim tws As Worksheet Set owb = ActiveWorkbook Set ows = ActiveWorkbook.ActiveSheet Dim SaveDriveDir As String 'save default path SaveDriveDir = CurDir TitleString = "Please select the Raw data file" 'change to new path DirectorySetPath (PathOnly) 'get the file newFN = Application.GetOpenFilename(FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", Title:=TitleString) If newFN = False Then ' They pressed Cancel MsgBox "Stopping because you did not select a file" 'return to original default path DirectorySetPath (SaveDriveDir) Exit Sub Else MyFullFilePath = newFN End If Application.StatusBar = "Opening File " & MyFullFilePath 'Open source workbook Application.DisplayAlerts = False Set twb = Workbooks.Open(Filename:=MyFullFilePath, UpdateLinks:=0, ReadOnly:=True) Application.DisplayAlerts = True twb.Activate twb.Sheets(1).Activate 'update the file For I = 1 To 6 ActiveWorkbook.Sheets.Add Next shtNameArr = Array("NWR", "NAR", "SWR", "SAR", "WWR") For I = 1 To 5 ActiveWorkbook.Sheets(7).Select ActiveWorkbook.Sheets(7).Cells.Select Selection.AutoFilter Selection.AutoFilter Field:=9, Criteria1:=shtNameArr(I) ActiveWorkbook.Sheets(7).Cells.Select Selection.Copy ActiveWorkbook.Sheets(I).Select ActiveSheet.Paste LRow = lastRow(Sheets(I)) ActiveSheet.Name = shtNameArr(I) ActiveSheet.Cells.Select ActiveSheet.Cells.EntireColumn.AutoFit ActiveSheet.Range("V1").Select Application.CutCopyMode = False ActiveCell.Value = "Days Late" ActiveSheet.Range("V2").Select ActiveCell.Formula = "=IF(M2L2,M2-L2,"""")" ActiveSheet.Range("V2").Select Selection.AutoFill Destination:=Range("V2:V" & LRow) ActiveSheet.Range("A1").Select Next ActiveWorkbook.Sheets(7).Select ActiveWorkbook.Sheets(7).Cells.Select Selection.AutoFilter Selection.AutoFilter Field:=9, Criteria1:="STTC" Selection.AutoFilter Field:=18, Criteria1:="=03", Operator:=xlOr, Criteria2:="=04" ActiveWorkbook.Sheets(7).Cells.Select Selection.Copy ActiveWorkbook.Sheets(6).Select ActiveSheet.Paste LRow = lastRow(ActiveWorkbook.Sheets(6)) ActiveSheet.Name = "STTC" ActiveSheet.Cells.Select ActiveSheet.Cells.EntireColumn.AutoFit ActiveSheet.Range("V1").Select Application.CutCopyMode = False ActiveCell.Value = "Days Late" ActiveSheet.Range("V2").Select ActiveCell.Formula = "=IF(M2L2,M2-L2,"""")" ActiveSheet.Range("V2").Select Selection.AutoFill Destination:=Range("V2:V" & LRow) ActiveSheet.Range("A1").Select ActiveWorkbook.Sheets(1).Activate Application.DisplayAlerts = False ActiveWorkbook.Sheets(7).Delete Application.DisplayAlerts = True 'Select/copy a single cell to avoid clipboard warnings ActiveSheet.Range("A1").Copy ''close the workbook to get it out of the way 'Application.DisplayAlerts = False 'just in case the clipboard trick doesn't work 'twb.Close SaveChanges:=False 'Application.DisplayAlerts = True Application.StatusBar = False sDate = Year(Now()) & Format(Month(Now()), "00") & Format(Day(Now()), "00") ShortFileName = ExtractFileName(MyFullFilePath) 'get the month "name" for the data set being saved, to put it in the filename PasteMonths = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12) PasteMonths2 = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") PasteMonthNum = CInt(InputBox("Enter the month number represented by this data (e.g. 1 for Jan, 2 for Feb, etc)", "Enter Data Month")) If IsError(Application.Match(PasteMonthNum, PasteMonths, False)) Then MsgBox "Unable to recognize a date from 1 to 12." & Chr(13) & Chr(13) & "Output file not saved; please run again to finish processing", , "Month Number Error" Exit Sub Else StrMonth = PasteMonths2(PasteMonthNum) End If DirectorySetPath ("\\wsak1\Perf\Score\Ops\Public\CurrentData") 'GetSaveAsFilename new2fn = Application.GetSaveAsFilename( _ InitialFileName:="2010 Ops Increases - " & PasteMonthNum & " " & StrMonth, _ FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", _ Title:=TitleString) ActiveWorkbook.SaveAs Filename:=new2fn 'return to original default path DirectorySetPath (SaveDriveDir) 'PullAllRawData = Now() MsgBox "Source data file has been successfully created and saved" OldShortFN = ExtractFileName(newFN) OldPathN = Left(newFN, Len(newFN) - Len(OldShortFN)) Debug.Print OldPathN & OldShortFN Name newFN As OldPathN & OldShortFN End Sub |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Code corrupts file (XL2003)
Final note:
When I interrupt the code right after the save, and go into that file and save it manually, the autosaved version is .xls and is still corrupt. When I click manually within the file to save it, it defaults to Excel 2007 filetype, with the corresponding .xlsx extention. Does the filesave dialogue automatically append the first filter in the dialogue? That would fit what I'm seeing as output. The original data file is stored as xlsx, so that would make sense as why the file is saving with an internal 2007 format. I'm just surprised that it isn't an automatic conversion (I'm inclined to think of this as a bug), and I'm not sure how to force it to save not just with the xls extension, but in fact in XL2003 format. Thanks, Keith "ker_01" wrote: Additional note: I appended ".xls" to the filename in the code , but testing still results in corrupt output file(s). "ker_01" wrote: I have code (below) that opens and processes a separate raw data file, segregates data into several different worksheets in that data file, then saves the file. I just found out that my code appears to corrupt the output files, which then cannot be opened in Excel2003, but can be opened in Excel2007. I can open *other* Excel files without a problem, but files created with this sub are corrupt. I suspect that it has to do with how the file is saved, so I'm posting just that snippet first, then the full code underneath. Should I be more restrictive in the Filefilter parameter? Or do I need to forceably add the ".xls" extension even though the save dialogue shows it to be saving as an XLS file? The file does save with the xls extension, and looks like an XL file in windows explorer (opens in Excel2003 when double clicked, but then throws an 'unrecognizable format' error, and shows a worksheet filled with ASCII characters). Any advice or suggestions would be greatly appreciated. Snippet: DirectorySetPath ("\\wsak1\Perf\Score\Ops\Public\CurrentData") new2fn = Application.GetSaveAsFilename( _ InitialFileName:="2010 USA Ops Salary Increases - " & PasteMonthNum & " " & StrMonth, _ FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", _ Title:=TitleString) ActiveWorkbook.SaveAs Filename:=new2fn Full code: Sub MakeReferenceWkbk() 'default start path, editable by user from the filepicker dialogue PathOnly = "\\wsak1\Perf\Score\Ops\People\Increases" Dim I As Integer Dim owb As Workbook 'original/main Dim twb As Workbook 'temp/data file Dim ows As Worksheet Dim tws As Worksheet Set owb = ActiveWorkbook Set ows = ActiveWorkbook.ActiveSheet Dim SaveDriveDir As String 'save default path SaveDriveDir = CurDir TitleString = "Please select the Raw data file" 'change to new path DirectorySetPath (PathOnly) 'get the file newFN = Application.GetOpenFilename(FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", Title:=TitleString) If newFN = False Then ' They pressed Cancel MsgBox "Stopping because you did not select a file" 'return to original default path DirectorySetPath (SaveDriveDir) Exit Sub Else MyFullFilePath = newFN End If Application.StatusBar = "Opening File " & MyFullFilePath 'Open source workbook Application.DisplayAlerts = False Set twb = Workbooks.Open(Filename:=MyFullFilePath, UpdateLinks:=0, ReadOnly:=True) Application.DisplayAlerts = True twb.Activate twb.Sheets(1).Activate 'update the file For I = 1 To 6 ActiveWorkbook.Sheets.Add Next shtNameArr = Array("NWR", "NAR", "SWR", "SAR", "WWR") For I = 1 To 5 ActiveWorkbook.Sheets(7).Select ActiveWorkbook.Sheets(7).Cells.Select Selection.AutoFilter Selection.AutoFilter Field:=9, Criteria1:=shtNameArr(I) ActiveWorkbook.Sheets(7).Cells.Select Selection.Copy ActiveWorkbook.Sheets(I).Select ActiveSheet.Paste LRow = lastRow(Sheets(I)) ActiveSheet.Name = shtNameArr(I) ActiveSheet.Cells.Select ActiveSheet.Cells.EntireColumn.AutoFit ActiveSheet.Range("V1").Select Application.CutCopyMode = False ActiveCell.Value = "Days Late" ActiveSheet.Range("V2").Select ActiveCell.Formula = "=IF(M2L2,M2-L2,"""")" ActiveSheet.Range("V2").Select Selection.AutoFill Destination:=Range("V2:V" & LRow) ActiveSheet.Range("A1").Select Next ActiveWorkbook.Sheets(7).Select ActiveWorkbook.Sheets(7).Cells.Select Selection.AutoFilter Selection.AutoFilter Field:=9, Criteria1:="STTC" Selection.AutoFilter Field:=18, Criteria1:="=03", Operator:=xlOr, Criteria2:="=04" ActiveWorkbook.Sheets(7).Cells.Select Selection.Copy ActiveWorkbook.Sheets(6).Select ActiveSheet.Paste LRow = lastRow(ActiveWorkbook.Sheets(6)) ActiveSheet.Name = "STTC" ActiveSheet.Cells.Select ActiveSheet.Cells.EntireColumn.AutoFit ActiveSheet.Range("V1").Select Application.CutCopyMode = False ActiveCell.Value = "Days Late" ActiveSheet.Range("V2").Select ActiveCell.Formula = "=IF(M2L2,M2-L2,"""")" ActiveSheet.Range("V2").Select Selection.AutoFill Destination:=Range("V2:V" & LRow) ActiveSheet.Range("A1").Select ActiveWorkbook.Sheets(1).Activate Application.DisplayAlerts = False ActiveWorkbook.Sheets(7).Delete Application.DisplayAlerts = True 'Select/copy a single cell to avoid clipboard warnings ActiveSheet.Range("A1").Copy ''close the workbook to get it out of the way 'Application.DisplayAlerts = False 'just in case the clipboard trick doesn't work 'twb.Close SaveChanges:=False 'Application.DisplayAlerts = True Application.StatusBar = False sDate = Year(Now()) & Format(Month(Now()), "00") & Format(Day(Now()), "00") ShortFileName = ExtractFileName(MyFullFilePath) 'get the month "name" for the data set being saved, to put it in the filename PasteMonths = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12) PasteMonths2 = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") PasteMonthNum = CInt(InputBox("Enter the month number represented by this data (e.g. 1 for Jan, 2 for Feb, etc)", "Enter Data Month")) If IsError(Application.Match(PasteMonthNum, PasteMonths, False)) Then MsgBox "Unable to recognize a date from 1 to 12." & Chr(13) & Chr(13) & "Output file not saved; please run again to finish processing", , "Month Number Error" Exit Sub Else StrMonth = PasteMonths2(PasteMonthNum) End If DirectorySetPath ("\\wsak1\Perf\Score\Ops\Public\CurrentData") 'GetSaveAsFilename new2fn = Application.GetSaveAsFilename( _ InitialFileName:="2010 Ops Increases - " & PasteMonthNum & " " & StrMonth, _ FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", _ Title:=TitleString) ActiveWorkbook.SaveAs Filename:=new2fn 'return to original default path DirectorySetPath (SaveDriveDir) 'PullAllRawData = Now() MsgBox "Source data file has been successfully created and saved" OldShortFN = ExtractFileName(newFN) OldPathN = Left(newFN, Len(newFN) - Len(OldShortFN)) Debug.Print OldPathN & OldShortFN Name newFN As OldPathN & OldShortFN End Sub |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Code corrupts file (XL2003)
For future reference; the files saved "uncorrupted" if I forced the file
extension to .xlsx (2007 format). Unfortunately, that adds time to convert the file while saving, and convert each time the file is re-opened. I'd still describe this as a bug; if Excel is going to save in 2007 format, it should automatically default to saving with an xlsx extension instead of xls My original question remains; how do I force Excel to save the file in actual 2003 file format, when the original file that was opened (via VBA) was 2007 format? Thanks, Keith "ker_01" wrote: Final note: When I interrupt the code right after the save, and go into that file and save it manually, the autosaved version is .xls and is still corrupt. When I click manually within the file to save it, it defaults to Excel 2007 filetype, with the corresponding .xlsx extention. Does the filesave dialogue automatically append the first filter in the dialogue? That would fit what I'm seeing as output. The original data file is stored as xlsx, so that would make sense as why the file is saving with an internal 2007 format. I'm just surprised that it isn't an automatic conversion (I'm inclined to think of this as a bug), and I'm not sure how to force it to save not just with the xls extension, but in fact in XL2003 format. Thanks, Keith "ker_01" wrote: Additional note: I appended ".xls" to the filename in the code , but testing still results in corrupt output file(s). "ker_01" wrote: I have code (below) that opens and processes a separate raw data file, segregates data into several different worksheets in that data file, then saves the file. I just found out that my code appears to corrupt the output files, which then cannot be opened in Excel2003, but can be opened in Excel2007. I can open *other* Excel files without a problem, but files created with this sub are corrupt. I suspect that it has to do with how the file is saved, so I'm posting just that snippet first, then the full code underneath. Should I be more restrictive in the Filefilter parameter? Or do I need to forceably add the ".xls" extension even though the save dialogue shows it to be saving as an XLS file? The file does save with the xls extension, and looks like an XL file in windows explorer (opens in Excel2003 when double clicked, but then throws an 'unrecognizable format' error, and shows a worksheet filled with ASCII characters). Any advice or suggestions would be greatly appreciated. Snippet: DirectorySetPath ("\\wsak1\Perf\Score\Ops\Public\CurrentData") new2fn = Application.GetSaveAsFilename( _ InitialFileName:="2010 USA Ops Salary Increases - " & PasteMonthNum & " " & StrMonth, _ FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", _ Title:=TitleString) ActiveWorkbook.SaveAs Filename:=new2fn Full code: Sub MakeReferenceWkbk() 'default start path, editable by user from the filepicker dialogue PathOnly = "\\wsak1\Perf\Score\Ops\People\Increases" Dim I As Integer Dim owb As Workbook 'original/main Dim twb As Workbook 'temp/data file Dim ows As Worksheet Dim tws As Worksheet Set owb = ActiveWorkbook Set ows = ActiveWorkbook.ActiveSheet Dim SaveDriveDir As String 'save default path SaveDriveDir = CurDir TitleString = "Please select the Raw data file" 'change to new path DirectorySetPath (PathOnly) 'get the file newFN = Application.GetOpenFilename(FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", Title:=TitleString) If newFN = False Then ' They pressed Cancel MsgBox "Stopping because you did not select a file" 'return to original default path DirectorySetPath (SaveDriveDir) Exit Sub Else MyFullFilePath = newFN End If Application.StatusBar = "Opening File " & MyFullFilePath 'Open source workbook Application.DisplayAlerts = False Set twb = Workbooks.Open(Filename:=MyFullFilePath, UpdateLinks:=0, ReadOnly:=True) Application.DisplayAlerts = True twb.Activate twb.Sheets(1).Activate 'update the file For I = 1 To 6 ActiveWorkbook.Sheets.Add Next shtNameArr = Array("NWR", "NAR", "SWR", "SAR", "WWR") For I = 1 To 5 ActiveWorkbook.Sheets(7).Select ActiveWorkbook.Sheets(7).Cells.Select Selection.AutoFilter Selection.AutoFilter Field:=9, Criteria1:=shtNameArr(I) ActiveWorkbook.Sheets(7).Cells.Select Selection.Copy ActiveWorkbook.Sheets(I).Select ActiveSheet.Paste LRow = lastRow(Sheets(I)) ActiveSheet.Name = shtNameArr(I) ActiveSheet.Cells.Select ActiveSheet.Cells.EntireColumn.AutoFit ActiveSheet.Range("V1").Select Application.CutCopyMode = False ActiveCell.Value = "Days Late" ActiveSheet.Range("V2").Select ActiveCell.Formula = "=IF(M2L2,M2-L2,"""")" ActiveSheet.Range("V2").Select Selection.AutoFill Destination:=Range("V2:V" & LRow) ActiveSheet.Range("A1").Select Next ActiveWorkbook.Sheets(7).Select ActiveWorkbook.Sheets(7).Cells.Select Selection.AutoFilter Selection.AutoFilter Field:=9, Criteria1:="STTC" Selection.AutoFilter Field:=18, Criteria1:="=03", Operator:=xlOr, Criteria2:="=04" ActiveWorkbook.Sheets(7).Cells.Select Selection.Copy ActiveWorkbook.Sheets(6).Select ActiveSheet.Paste LRow = lastRow(ActiveWorkbook.Sheets(6)) ActiveSheet.Name = "STTC" ActiveSheet.Cells.Select ActiveSheet.Cells.EntireColumn.AutoFit ActiveSheet.Range("V1").Select Application.CutCopyMode = False ActiveCell.Value = "Days Late" ActiveSheet.Range("V2").Select ActiveCell.Formula = "=IF(M2L2,M2-L2,"""")" ActiveSheet.Range("V2").Select Selection.AutoFill Destination:=Range("V2:V" & LRow) ActiveSheet.Range("A1").Select ActiveWorkbook.Sheets(1).Activate Application.DisplayAlerts = False ActiveWorkbook.Sheets(7).Delete Application.DisplayAlerts = True 'Select/copy a single cell to avoid clipboard warnings ActiveSheet.Range("A1").Copy ''close the workbook to get it out of the way 'Application.DisplayAlerts = False 'just in case the clipboard trick doesn't work 'twb.Close SaveChanges:=False 'Application.DisplayAlerts = True Application.StatusBar = False sDate = Year(Now()) & Format(Month(Now()), "00") & Format(Day(Now()), "00") ShortFileName = ExtractFileName(MyFullFilePath) 'get the month "name" for the data set being saved, to put it in the filename PasteMonths = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12) PasteMonths2 = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") PasteMonthNum = CInt(InputBox("Enter the month number represented by this data (e.g. 1 for Jan, 2 for Feb, etc)", "Enter Data Month")) If IsError(Application.Match(PasteMonthNum, PasteMonths, False)) Then MsgBox "Unable to recognize a date from 1 to 12." & Chr(13) & Chr(13) & "Output file not saved; please run again to finish processing", , "Month Number Error" Exit Sub Else StrMonth = PasteMonths2(PasteMonthNum) End If DirectorySetPath ("\\wsak1\Perf\Score\Ops\Public\CurrentData") 'GetSaveAsFilename new2fn = Application.GetSaveAsFilename( _ InitialFileName:="2010 Ops Increases - " & PasteMonthNum & " " & StrMonth, _ FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", _ Title:=TitleString) ActiveWorkbook.SaveAs Filename:=new2fn 'return to original default path DirectorySetPath (SaveDriveDir) 'PullAllRawData = Now() MsgBox "Source data file has been successfully created and saved" OldShortFN = ExtractFileName(newFN) OldPathN = Left(newFN, Len(newFN) - Len(OldShortFN)) Debug.Print OldPathN & OldShortFN Name newFN As OldPathN & OldShortFN End Sub |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| XL2003 to XL2000 code converson | Excel Programming | |||
| VBA copy 'corrupts' font selection (XL2003) | Excel Programming | |||
| Excel Copy, Paste not working properly, corrupts file | Excel Discussion (Misc queries) | |||
| File corrupts when saving under a different name - xl2000 | Excel Discussion (Misc queries) | |||
| SaveAs - user pushing cancel corrupts the file | Excel Programming | |||
Linear Mode
