snuffnchess
Board Regular
- Joined
- May 15, 2015
- Messages
- 71
- Office Version
- 365
- Platform
- Windows
I am getting an error when saving a workbook SOMETIMES.... and it is completely baffling me. Cannot figure out a rhyme or reason to when it works.
I have verified using a msgbox that the saveas folder / file name is correct. The filtered data copies to a newbook... I see it happen - the message box comes up showing that it is correct.. I hit next on the messagebox and then I SOMETIMES get a "Run Time Error '1004' method 'SaveAs' of object'_Workbook' failed"
If I click the debug button, and then then F8 to continue on, I get a "Document not saved" error box. But here is the kicker. When I go to the directory that it is supposed to save the file in.. the file is there!
Im so confused... Help!!!
I have verified using a msgbox that the saveas folder / file name is correct. The filtered data copies to a newbook... I see it happen - the message box comes up showing that it is correct.. I hit next on the messagebox and then I SOMETIMES get a "Run Time Error '1004' method 'SaveAs' of object'_Workbook' failed"
If I click the debug button, and then then F8 to continue on, I get a "Document not saved" error box. But here is the kicker. When I go to the directory that it is supposed to save the file in.. the file is there!
Im so confused... Help!!!
VBA Code:
Option Explicit
Public sfile As String
Public adfile As String
Public sFolder As String
Public sFilename As String
Public adfolder As String
Public sdir As String
Public sfolca As String
Sub cceod()
Dim ob As Workbook
Dim eoddata As Worksheet
Dim cwdown As Workbook
Dim nb As Workbook
Dim ns As Worksheet
Dim REC1 As Variant
Dim trandate As String
Dim sdata As Long
Dim eoddatasortArr
Dim eoddatacel As Range
Dim r As Range
Dim rv As Range
Dim fldr As FileDialog
Dim strpath As String
Dim sItem As String
Dim eodlrow As Long
Dim eodlcol As Long
Dim i As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set ob = ThisWorkbook
Set eoddata = ob.Sheets("EOD")
eoddata.Visible = xlSheetVisible
eoddata.Cells.Clear
trandate = InputBox("Enter Transaction Date mm/dd/yyyy format")
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder to save Files to"
.AllowMultiSelect = False
.InitialFileName = strpath
If .Show <> -1 Then Exit Sub
sItem = .SelectedItems(1)
End With
sfolca = sItem & "\" & Format(trandate, "yyyy-mm-dd") & "\"
If Len(Dir(sfolca, vbDirectory)) = 0 Then
MkDir sfolca
End If
If Len(Dir(sfolca & "Batch Success", vbDirectory)) = 0 Then
MkDir sfolca & "Batch Success"
End If
If Len(Dir(sfolca & "Batch Fail", vbDirectory)) = 0 Then
MkDir sfolca & "Batch Fail"
End If
If Len(Dir(sfolca & "Manual Success", vbDirectory)) = 0 Then
MkDir sfolca & "Manual Success"
End If
If Len(Dir(sfolca & "Manual Fail", vbDirectory)) = 0 Then
MkDir sfolca & "Manual Fail"
End If
REC1 = Application.GetOpenFilename(Title:="Select Data", FileFilter:="Excel Files (*.xls*; *.csv),*.xls*; *.csv")
If REC1 <> False Then
Set cwdown = Application.Workbooks.Open(REC1)
With cwdown.Sheets(1).UsedRange
.Resize(.Rows.Count, .Columns.Count).Offset(0, 0).Copy
End With
eoddata.Range("A1").PasteSpecial xlPasteValues
Columns.AutoFit
cwdown.Close False
End If
eodlrow = eoddata.Range("A1").End(xlDown).Row
eoddata.Columns("L:N").Select
With Selection
Selection.NumberFormat = "General"
.Value = .Value
.NumberFormat = "0.00"
End With
eoddata.Cells(1, 1).Value = "POSTDATE"
eoddata.Cells(1, 2).Value = "CUSTOMERNUMBER"
eoddata.Cells(1, 3).Value = "AMOUNT"
eoddata.Cells(1, 4).Value = "TYPE"
eoddata.Cells(1, 5).Value = "CHECK/CC NUMBER"
eoddata.Cells(1, 6).Value = "INVOICENUMBER"
eoddata.Cells(1, 7).Value = "OPTIONAL DESCRIPTION FIELD"
eodlcol = Range("A1").End(xlToRight).Column
eoddata.Cells(1, eodlcol + 1).Value = trandate
eoddata.Cells(1, eodlcol + 1).Select
Selection.NumberFormat = "yyyy-mm-dd"
sdata = eoddata.Cells(1, eodlcol + 1)
Set r = eoddata.Range(Cells(1, 1), Cells(eodlrow, eodlcol))
r.AutoFilter field:=14, Criteria1:="Batch Upload"
r.AutoFilter field:=12, Criteria1:="success"
Set rv = eoddata.Range(Cells(1, 1), Cells(eodlrow, 7)).SpecialCells(xlCellTypeVisible)
If rv.Rows.Count > 1 Or rv.Areas.Count > 1 Then
rv.Copy
Set nb = Workbooks.Add
Set ns = nb.Worksheets(1)
ns.Cells(1, 1).PasteSpecial xlPasteAll
'ns.Columns.AutoFit
Application.CutCopyMode = False
nb.Activate
sFilename = "batchsuccess"
MsgBox sfolca & "Batch Success\" & sFilename & ".xlsx"
nb.SaveAs sfolca & "Batch Success\" & sFilename & ".xlsx", 51
nb.Close False
End If
r.AutoFilter field:=14, Criteria1:="Batch Upload"
r.AutoFilter field:=12, Criteria1:="<>success"
Set rv = eoddata.Range(Cells(1, 1), Cells(eodlrow, 7)).SpecialCells(xlCellTypeVisible)
If rv.Rows.Count > 1 Or rv.Areas.Count > 1 Then
rv.Copy
Set nb = Workbooks.Add
Set ns = nb.Worksheets(1)
ns.Cells(1, 1).PasteSpecial xlPasteAll
Application.CutCopyMode = False
nb.Activate
sFilename = "batchfail"
MsgBox sfolca & "Batch Fail\" & sFilename & ".xlsx"
nb.SaveAs sfolca & "Batch Fail\" & sFilename & ".xlsx", 51
nb.Close False
End If
r.AutoFilter field:=14, Criteria1:="<>Batch Upload"
r.AutoFilter field:=12, Criteria1:="success"
Set rv = eoddata.Range(Cells(1, 1), Cells(eodlrow, 7)).SpecialCells(xlCellTypeVisible)
If rv.Rows.Count > 1 Or rv.Areas.Count > 1 Then
rv.Copy
Set nb = Workbooks.Add
Set ns = nb.Worksheets(1)
ns.Cells(1, 1).PasteSpecial xlPasteAll
Application.CutCopyMode = False
nb.Activate
sFilename = "manualsuccess"
MsgBox sfolca & "Manual Success\" & sFilename & ".xlsx"
nb.SaveAs sfolca & "Manual Success\" & sFilename & ".xlsx", 51
nb.Close False
End If
r.AutoFilter field:=14, Criteria1:="<>Batch Upload"
r.AutoFilter field:=12, Criteria1:="<>success"
Set rv = eoddata.Range(Cells(1, 1), Cells(eodlrow, 7)).SpecialCells(xlCellTypeVisible)
If rv.Rows.Count > 1 Or rv.Areas.Count > 1 Then
rv.Copy
Set nb = Workbooks.Add
Set ns = nb.Worksheets(1)
ns.Cells(1, 1).PasteSpecial xlPasteAll
Application.CutCopyMode = False
nb.Activate
sFilename = "manualfail"
MsgBox sfolca & "Manual Fail\" & sFilename & ".xlsx"
nb.SaveAs sfolca & "Manual Fail\" & sFilename & ".xlsx", 51
nb.Close False
End If
eoddata.ShowAllData
'eod.Visible = xlsheethidden
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
