Close the save dialogue without breaking my VBA

[cdterford]

Excel 2010

So I have some complex (to me) VBA code that I retrieved from here: http://www.mrexcel.com/forum/excel-...ns-copy-specified-cells-all-files-folder.html from user Nirvana_. The code's purpose is to look through a directory of excel files, and essentially pull the cell values from certain cells and then paste those values into cells in another workbook (we can call the "Master Workbook"). To do this, it very quickly opens and then closes every workbook.

After modifying this, it worked great for me! But after a day, something went wrong, or perhaps I changed something on accident. The issue is this -- Before I would click a button on my Master Workbook and the files would quickly open and close, recording the data I need one line after another. Now, every workbook prompts for a save, and it will not automatically close until I click "Save," "Don't Save," or "Cancel." Furthermore, unless I click "Save," the data will not be recorded at all! This is a bizarre issue to me, since nothing should be changing on the files it opens, and if nothing is changing, I don't think it is supposed to prompt for a save. Or if it is, this is strange behavior to me since it didn't do this at all throughout an entire workday of testing and work with it.

Another thing to note; I have 5 Excel Workbooks that a user will input information into. Upon completion, a pseudo-unique string of text will be generated to match the parts they selected, and the user will click a "save as .xlsm and .pdf" button, which will do the following:

Save the file with the name as the value in K12, which is where the unique string of text referenced above is generated to, the file will be saved in a different directory than original.

Export the file as a .pdf which the user is allowed to name, and

Close the generated file.

So, when the user is done with the form, they will have generated a new workbook into a separate directory without actually modifying the original form.

The thing is, those generated forms really never get opened except for when the VBA on "Master Workbook" opens to grab the data. So inbetween their creation and having their data collection, they do not move, get modified, change file types, or anything like that. I am stumped as to why this even began happening.

Here's the code I'm using (bold italics are areas I changed from the original):

Option ExplicitPublic strSourceFldr As String
Public EachFile As Object
Public objFSO As Object
Public objFolder As Object
Public objFile As Object
Public strSheetName As String
Public strSrcCell1 As String
Public strSrcCell2 As String
Public strSrcCell3 As String
Public strSrcCell4 As String
Public intStartCell As Integer
Sub DataCopy()
    strSourceFldr = "[I][B]My folder location here[/B][/I]\"
    strSheetName = "Sheet1"
    strSrcCell1 = "[I][B]B4[/B][/I]"
    strSrcCell2 = "[I][B]A5[/B][/I]"
    intStartCell = 8
    Set objFSO = CreateObject("Scripting.Filesystemobject")
    Set objFolder = objFSO.GetFolder(strSourceFldr)
    For Each EachFile In objFolder.Files
        If LCase(objFSO.GetExtensionName(EachFile)) = "[I][B]xlsm[/B][/I]" Then
            ProcessFile EachFile
        End If
    Next
    ProcessSubFolder objFSO.GetFolder(strSourceFldr)
End Sub
Sub ProcessFile(ByRef ThisFile As Object)
    Dim Cell1, Cell2, Cell3, Cell4
    Set objFile = objFSO.GetFile(ThisFile)
    Workbooks.Open ThisFile
    Cell1 = Range(strSrcCell1).Value
    Cell2 = Range(strSrcCell2).Value
[I][B]'removed redundant cell = ranges here[/B][/I]
    ActiveWorkbook.Close
    Worksheets(1).Cells(intStartCell, 1) = ThisFile.Name
    Worksheets(1).Cells(intStartCell, 2) = Cell1
    Worksheets(1).Cells(intStartCell, 3) = Cell2
    Worksheets(1).Cells(intStartCell, 4) = Cell3
    Worksheets(1).Cells(intStartCell, 5) = Cell4
    Worksheets(1).Cells(intStartCell, 6) = ThisFile.Path
    intStartCell = intStartCell + 1
End Sub
Sub ProcessSubFolder(ByRef ThisFolder As Object)
    Dim SubFolder
    For Each SubFolder In ThisFolder.SubFolders
        Set objFolder = objFSO.GetFolder(SubFolder.Path)
        For Each EachFile In objFolder.Files
            If LCase(objFSO.GetExtensionName(EachFile)) = "[I][B]xlsm[/B][/I]" Then
                ProcessFile EachFile
            End If
        Next
        ProcessSubFolder objFolder
    Next
End Sub

The original code is as follows:

[COLOR=#333333]Option Explicit[/COLOR]Public strSourceFldr As String
Public EachFile As Object
Public objFSO As Object
Public objFolder As Object
Public objFile As Object
Public strSheetName As String
Public strSrcCell1 As String
Public strSrcCell2 As String
Public strSrcCell3 As String
Public strSrcCell4 As String
Public intStartCell As Integer
Sub DataCopy()
    strSourceFldr = Worksheets(1).Cells(1, 14)
    strSheetName = "Sheet1"
    strSrcCell1 = "B2"
    strSrcCell2 = "C2"
    strSrcCell3 = "D4"
    strSrcCell4 = "F3"
    intStartCell = 2
    Set objFSO = CreateObject("Scripting.Filesystemobject")
    Set objFolder = objFSO.GetFolder(strSourceFldr)
    For Each EachFile In objFolder.Files
        If LCase(objFSO.GetExtensionName(EachFile)) = "xls" Then
            ProcessFile EachFile
        End If
    Next
    ProcessSubFolder objFSO.GetFolder(strSourceFldr)
End Sub
Sub ProcessFile(ByRef ThisFile As Object)
    Dim Cell1, Cell2, Cell3, Cell4
    Set objFile = objFSO.GetFile(ThisFile)
    Workbooks.Open ThisFile
    Cell1 = Range(strSrcCell1).Value
    Cell2 = Range(strSrcCell2).Value
    Cell3 = Range(strSrcCell3).Value
    Cell4 = Range(strSrcCell4).Value
    ActiveWorkbook.Close
    Worksheets(1).Cells(intStartCell, 1) = ThisFile.Name
    Worksheets(1).Cells(intStartCell, 2) = Cell1
    Worksheets(1).Cells(intStartCell, 3) = Cell2
    Worksheets(1).Cells(intStartCell, 4) = Cell3
    Worksheets(1).Cells(intStartCell, 5) = Cell4
    Worksheets(1).Cells(intStartCell, 6) = ThisFile.Path
    intStartCell = intStartCell + 1
End Sub
Sub ProcessSubFolder(ByRef ThisFolder As Object)
    Dim SubFolder
    For Each SubFolder In ThisFolder.SubFolders
        Set objFolder = objFSO.GetFolder(SubFolder.Path)
        For Each EachFile In objFolder.Files
            If LCase(objFSO.GetExtensionName(EachFile)) = "xls" Then
                ProcessFile EachFile
            End If
        Next
        ProcessSubFolder objFolder
    Next [COLOR=#333333]End Sub[/COLOR]

Can anybody help me either fix the error or add in a sub that will mark the files as "saved" between the time they are opened and closed (perhaps adding in one of the bits mentioned here https://support.microsoft.com/en-us/kb/213428)?

Thanks!

 

[cdterford]

Also, apologies for the strange formatting. I wasn't able to fix it before my 10 minutes was up!

 

[cdterford]

For anybody reading or hoping to use this, that may run into the same problem, I fixed it on my own by adding "ActiveWorkbook.Saved = True" a line before "ActiveWorkbook.Close" as shown below

 Cell1 = Range(strSrcCell1).Value    Cell2 = Range(strSrcCell2).Value
[B]    ActiveWorkbook.Saved = True[/B]
[B]        ActiveWorkbook.Close[/B]
    Worksheets(1).Cells(intStartCell, 1) = ThisFile.Name
    Worksheets(1).Cells(intStartCell, 2) = Cell1