I have an excel file that exists on an iSeries IFS file system.
I open the Excel workbook from iSeries IFS file system and I delete a column and then use .save to save.
I have .visible = true and I can see the Excel workbook from iSeries IFS file system open, delete the column I wanted deleted.
When the save happens there are no errors message. When .close happens the Excel workbook from iSeries IFS file system closes like expected.
When I copy the Excel workbook from iSeries IFS file system to my desktop PC the column I saw deleted remains in the workbook. However, when I went to open this file in Excel from my desktop I received an error message: "Office File Validation detected a problem while trying to open this file. Opening may be dangerous."
Being there were no error messages when .save happened I was looking forward to the file being saved correctly.
This post may be a long shot for the forum. I am new to VBA projects and there may not be that many folks out there with both iSeries IFS and VBA experience.
Any help would be appreciated.
Below is the code:
The sub I have been testing .save is "DeleteDWRColumn"
In the main excel workbook with these macros there is a path and file for an Excel workbook on IFS file system
Public index As Integer, workbookname As String, workbookpath As String, sourceworkbook As Workbook, destworkbook As Workbook
Sub DWRUpdate()
Dim strPathFileName As String
Dim strDWRcol As String
Dim strActionFlg As String
Dim PassFailFlag As String
Dim iFirstRow As Long
Dim iLastRow As Long
Dim searchstring As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Set variable for this work as source workbook
Set sourceworkbook = ActiveWorkbook
' loop through master excel and assign DWR column and action column based on
' what folder resides
' assignColforDWRandAction(this changes col B and C in workbook AND
' NOT NEEDED FOR THIS SAMPLE
'Search for "Not Matched" in Path or the action Flag = A for Mask Sub
searchstring = "Not Matched"
iFirstRow = 1
'Get last Row that has data
iLastRow = Application.WorksheetFunction.CountA(Range("A:A"))
'Loop through DWR IFS worksheet to identify the folders and files that need to have DWR cleared
For index = iFirstRow To iLastRow
'Set ActiveCell
'Get FileName for current row
Range("A" & index).Select
strPathFileName = ActiveCell.Text
'Get DWRcol for current row
Range("B" & index).Select
strDWRcol = ActiveCell.Text
If Dir(strPathFileName) <> "" Then
Range("C" & index).Select
strActionFlg = ActiveCell.Text
Range("D" & index).Select
PassFailFlag = ActiveCell.Text
' Check to make sure the action flag is for delete and this has not been processed before
If (strActionFlg = "B") And _
PassFailFlag = "" Then
'Get Action Flg to determine how DWR to process
'Call to sub for files where column will be deleted
DeleteDWRColumn strPathFileName, strDWRcol
Worksheets(1).Range("D" & index).Activate
ActiveCell.Value = "Passed"
Worksheets(1).Range("E" & index).Activate
ActiveCell.Value = "File Update: " + (strPathFileName) + " - Column " + (strDWRcol)
End If
Else
Worksheets(1).Range("D" & index).Activate
ActiveCell.Value = "Failed"
Worksheets(1).Range("E" & index).Activate
ActiveCell.Value = "There is no file with this name: " + (strPathFileName) + " - Column " + (strDWRcol)
' MsgBox "There is no file with this name: " + (strPathFileName), vbInformation
End If
Next index
MsgBox "DWR IFS Clean-up complete"
End Sub
Sub DeleteDWRColumn(strPathFile As String, strCol As String)
Dim fileFormatNumber As Long
' These next can be deletecode
Dim workbooknamebefore As String
Dim workbooknameafter As String
Dim srcwb As Workbook
Dim writewb As Workbook
Dim SaveFormat As Long
strCol = strCol + ":" + strCol
Workbooks.Open strPathFile
Sheets(1).Select
'save destination workbook
Set destworkbook = ActiveWorkbook
'Deletes entire column
Range(strCol).Delete
fileFormatNumber = CheckFileFormat()
If fileFormatNumber <> 56 Then
SaveFileNewFormat (strPathFile)
Else
workbookname = destworkbook.Name
workbookpath = destworkbook.Path
With Workbooks(workbookname)
' just in case there is a compatibility issue
ActiveWorkbook.CheckCompatibility = False
.Save
.Close
End With
End If
End Sub
Function CheckFileFormat()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
'deletecode
'With Application
' .ScreenUpdating = True
' .EnableEvents = True
'End With
'Determine the Excel version and file extension/format
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
MsgBox "Excel Version is < 12 " & Application.Version
Else
'You use Excel 2007-2010
'We exit the sub when your answer is NO in the security dialog that you
'only see when you copy a sheet from a xlsm file with macro's disabled.
'If Sourcewb.Name = .Name Then
If ActiveWorkbook.FileFormat <> 56 Then
MsgBox "File Format <> 56, File format is " & ActiveWorkbook.FileFormat
End If
Select Case ActiveWorkbook.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If ActiveWorkbook.HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
'Return file format to calling sub
CheckFileFormat = FileFormatNum
'deletecode
'With Application
' .ScreenUpdating = False
' .EnableEvents = False
'End With
End Function
Sub SaveFileNewFormat(PathFile As String)
'Working in Excel 97-2007
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
'deletecode
'With Application
' .ScreenUpdating = False
' .EnableEvents = False
'End With
Set Sourcewb = ActiveWorkbook
FileExtStr = ActiveWorkbook.Name
'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
FileExtStr = ActiveWorkbook.Name
FileExtStr = Sourcewb.Name
FileExtStr = Destwb.Name
'Save the new workbook and close
With Destwb
.SaveAs PathFile & ".xlsx", FileFormat:=51
.Close SaveChanges:=False
End With
'Close and do not save the original workbook with non 56 file format
With Sourcewb
.Close SaveChanges:=False
End With
FileExtStr = ActiveWorkbook.Name
Worksheets(1).Range("F" & index).Activate
ActiveCell.Value = "File Created " + (PathFile) + ".xlsx" + " File Format = 56 "
End Sub
Bookmarks