{var%20f='http://v.t.sina.com.cn/share/share.php?appkey=1515056452',u=z||d.location,p=['&url=',e(u),'&title=',e(t||d.title),'&source=',e(r),'&sourceUrl=',e(l),'&content=',c||'gb2312','&pic=',e(p||'')].join('');function%20a(){if(!window.open([f,p].join(''),'mb',['toolbar=0,status=0,resizable=1,width=440,height=430,left=',(s.width-440)/2,',top=',(s.height-430)/2].join('')))u.href=[f,p].join('');};if(/Firefox/.test(navigator.userAgent))setTimeout(a,0);else%20a();})(screen,document,encodeURIComponent,'','','https://www.manongdao.com/data/attach/logo/logo.png', '推荐 够拽才男人 的问题《deleting database connection in excel vba macro》','https://www.manongdao.com/q-1071982.html','页面编码gb2312|utf-8默认gb2312'));){kind=link}
So I have managed to use a template to create multiple excel files that are saved as a .xlsx file to ensure the macro is not saved as part of the newly created files. However, I now have the problem of the database connections that are refreshed within macro. If I delete these, the following files create will have the data from the original file created as the connection strings have been broken. It seems the way this process works is that the next file is created from the previous, not from the template - a kind-of bucket brigade approach. Now I know people are going to ask me what I have tried but it has taken a few weeks (of time snatched when I get a chance) to get to this point and I can get no further. Please guys, I have googled and tried the hell out of everything but it is beyond me. Please can you help? I have included in my code, the part that deletes the connections - but as I say, this is not the correct approach it seems.
Thank you
Sub Button3_Click()
Dim MyCell As Range, MyRange As Range
Dim LR As Long
If Dir("P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\", vbDirectory) = "" Then
MkDir Path:="P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\"
End If
If Dir("P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\Trust Code Files\", vbDirectory) = "" Then
MkDir Path:="P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\Trust Code Files\"
End If
LR = Range("A" & Rows.Count).End(xlUp).Row
'this gets the values for workbook names
Set MyRange = Range("A2:A" & LR).SpecialCells(xlCellTypeVisible)
Dim xConnect As Object
For Each MyCell In MyRange
'this populates a cell with the name in the range that the workbook then references for refreshing an MS query
Worksheets("Front Sheet").Cells(5, 5) = MyCell.Value
Worksheets("Front Sheet").Cells(5, 6) = MyCell.Offset(, 1).Value
Worksheets("Front Sheet").Cells(5, 7) = MyCell.Offset(, 2).Value
Worksheets("Front Sheet").Cells(5, 8) = MyCell.Offset(, 3).Value
Worksheets("Front Sheet").Cells(5, 9) = MyCell.Offset(, 4).Value
Application.DisplayAlerts = False
ActiveWorkbook.RefreshAll
ActiveWorkbook.Sheets("Speciality Score Card").Range("B7:D16").Interior.Color = RGB(251, 222, 5) 'light yellow
ActiveWorkbook.Sheets("Speciality Score Card").Range("B6:D6").Interior.Color = RGB(255, 192, 0) ' dark yellow
ActiveWorkbook.Sheets("Speciality Score Card").Range("E6:E6").Interior.Color = RGB(231, 25, 25) 'dark red
ActiveWorkbook.Sheets("Speciality Score Card").Range("E7:G16").Interior.Color = RGB(255, 0, 0) 'light red
ActiveWorkbook.Sheets("Speciality Score Card").Range("B17:D17").Interior.Color = RGB(0, 102, 0) 'dark green
ActiveWorkbook.Sheets("Speciality Score Card").Range("B18:D32").Interior.Color = RGB(0, 176, 80) 'light green
ActiveWorkbook.Sheets("Speciality Score Card").Range("E18:G32").Interior.Color = RGB(0, 88, 154) 'light blue
ActiveWorkbook.Sheets("Speciality Score Card").PivotTables("PivotTable3").DataBodyRange.Interior.Color = RGB(0, 88, 154) 'light blue
ActiveWorkbook.Sheets("Speciality Score Card").PivotTables("PivotTable3").RowRange.Interior.Color = RGB(0, 88, 154) 'light blue
ActiveWorkbook.Sheets("Speciality Score Card").Range("E17:G17").Interior.Color = RGB(0, 32, 96) 'dark blue
' ActiveWorkbook.Sheets("Overview Score Card").Range("C1").Copy
' ActiveWorkbook.Sheets("Overview Score Card").Range("C1").PasteSpecial (xlPasteValues)
ActiveWorkbook.Saved = True
ActiveWorkbook.Sheets("Members").Visible = False
ActiveWorkbook.Sheets("Front Sheet").Visible = False
Worksheets("Graphs Red Zone").PageSetup.CenterFooter = Worksheets("Overview Score Card").Range("A4:F4").Value
Worksheets("Graphs Blue Zone").PageSetup.CenterFooter = Worksheets("Overview Score Card").Range("A4:F4").Value
Worksheets("Graphs Yellow Zone").PageSetup.CenterFooter = Worksheets("Overview Score Card").Range("A4:F4").Value
Worksheets("Graphs Green Zone").PageSetup.CenterFooter = Worksheets("Overview Score Card").Range("A4:F4").Value
ActiveWorkbook.SaveAs Filename:="P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\" & "CNST - " & MyCell.Value & " " & Format(Now(), "dd-mmm-yyyy") & ".xlsx", FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.SaveAs Filename:="P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\Trust Code Files\" & MyCell.Offset(, 5).Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook
Dim wkb As Workbook
Set wkb = Workbooks.Open(Filename:="P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\" & "CNST - " & MyCell.Value & " " & Format(Now(), "dd-mmm-yyyy") & ".xlsx")
Dim wkb2 As Workbook
Set wkb2 = Workbooks.Open(Filename:="P:\Informatics\S&L scorecards\02 Clinical Scorecards\" & Format(Now(), "yyyy") & "\Trust Code Files\" & MyCell.Offset(, 5).Value & ".xlsx")
Application.DisplayAlerts = True
Next MyCell
' this deletes connections
For Each xConnect In wkb.Connections
If xConnect.Name <> "ThisWorkbookDataModel" Then xConnect.Delete
Next xConnect
For Each xConnect In wkb2.Connections
If xConnect.Name <> "ThisWorkbookDataModel" Then xConnect.Delete
Next xConnect
ActiveWorkbook.Close
End Sub
I think the following will sove your problem. See also the comments to your question.
The subroutine
Button3_clieck()is in the current workbook. That workbook also has the cells with information to create the other workbooks.You have a separate workbook with the sheets that you use as a template (create it from your current workbook with the macro). It is opened in the while loop for each cell:
After you formatted the sheets, you save it under your names and then close it. You will open it again in the next iteration of the while loop.
After saving your two workbooks, you re-open them again to remove the connection. Then you close them.
Now you process the next cell.
The following (pseudo) code illustrates this. I couldn't check the code so there may be some errors.