?
Solved

Save As worksheet from active workbook as new xlxs in new folder removing the linked datasources

Posted on 2016-07-27
6
Medium Priority
?
56 Views
Last Modified: 2016-07-29
Looking for the correct syntax to saveas a workbook with out the linked files.  what is the correct Type:=?????

This is what I have so far
    ActiveSheet.ExportAsFixedFormat Type:=xlOpenXMLWorkbook, FileName:=FilePath3, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False

Open in new window

0
Comment
Question by:Karen Schaefer
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
6 Comments
 
LVL 21

Expert Comment

by:Roy Cox
ID: 41732379
Try adding some code to remove the Links

Option Explicit


Sub BreakLink()

    Dim arrLinks As Variant
    Dim iCnt   As Long

    arrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)

    If IsArray(arrLinks) Then
        For iCnt = LBound(arrLinks) To UBound(arrLinks)
            ActiveWorkbook.BreakLink Name:=arrLinks(iCnt), _
                                     Type:=xlLinkTypeExcelLinks
        Next iCnt
    End If

End Sub

Open in new window


Combine it with your code

Option Explicit


Sub BreakLink()

    Dim arrLinks As Variant
    Dim iCnt As Long

    ActiveSheet.ExportAsFixedFormat Type:=xlOpenXMLWorkbook, Filename:=FilePath3, _
                                    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, OpenAfterPublish:=False
    With ActiveWorkbook
        arrLinks = iCnt.LinkSources(Type:=xlLinkTypeExcelLinks)

        If IsArray(arrLinks) Then
            For iCnt = LBound(arrLinks) To UBound(arrLinks)
                iCnt.BreakLink Name:=arrLinks(iCnt), _
                               Type:=xlLinkTypeExcelLinks
            Next iCnt
        End If

        iCnt.Save
    End With
End Sub

Open in new window

0
 

Author Comment

by:Karen Schaefer
ID: 41733674
Roy I found the solution within my own code, thanks for your time.

Sub SaveFinalData()
    Dim nm As Name
    Dim ws As Worksheet
    Dim nDate As String
    Dim aCell As Range
    Dim FilePath As String
    Dim FilePath2 As String
    Dim FilePath3 As String
    Dim nMth As String
    Dim curDate As String
    Dim nName As String
    Application.DisplayAlerts = True
    nDate = Format(Date, "mmddyyyy")

    nMth = Format(Range("InvoiceForm!D5"), "mmm yyyy")
    nName = Sheets("MainForm").Range("B3").Value2 & "_" & Sheets("MainForm").Range("D3").Value2 & "_" & "Invoice"
    FilePath = Sheets("MainForm").Range("G3").Value & "\" & nMth
    FilePath2 = FilePath & "\" & nName & "_" & ReplaceAll(nMth, " ", "_") & ".xlsx"
 
    With Application
        .ScreenUpdating = False

        On Error GoTo ErrCatcher
        Sheets("InvoiceForm").Visible = True
        Sheets("InvoiceForm").Activate
        Sheets(Array("InvoiceForm")).Copy

        On Error GoTo 0
        If FileFolderExists(FilePath) = False Then
            If _
                MsgBox("File not found, do you wish to create a directory for" _
                & " " & nMth & "?", vbYesNo, "Create New Directory") = _
                vbYes Then
                CreateNewDirectory (FilePath2)
            End If
        End If
        
            UnlockSheets
        
        For Each ws In ActiveWorkbook.Worksheets
            'ws.Cells.Copy
            Selection.Copy
            ws.[A1].PasteSpecial Paste:=xlPasteValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
        Next ws

        Cells(1, 1).Select
        FilePath3 = FilePath & "\" & nName & "_" & ReplaceAll(nMth, " ", "_")
        Sheets("InvoiceForm").Visible = True
        Sheets("InvoiceForm").Activate

        ActiveWorkbook.SaveCopyAs FilePath3 & ".xlsx"
        ActiveWorkbook.Close SaveChanges:=False
        .ScreenUpdating = True
    End With
    Exit Sub
            LockSheets
            Application.DisplayAlerts = False
ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"
End Sub

Open in new window

0
 

Author Comment

by:Karen Schaefer
ID: 41733679
Thanks Roy for your input found solution within my existing code.
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 21

Accepted Solution

by:
Roy Cox earned 2000 total points
ID: 41734170
I've made a few suggestions in your code
Option Explicit

Sub SaveFinalData()
    Dim nm As Name
    Dim ws As Worksheet
    Dim nDate As String
'    Dim aCell As Range
    Dim FilePath As String
    Dim FilePath2 As String
    Dim FilePath3 As String
    Dim nMth As String
'    Dim curDate As String
    Dim nName As String
    ''/// not necessary
    '    Application.DisplayAlerts = True
    nDate = Format(Date, "mmddyyyy")
    With Sheets("InvoiceForm")
        ' nMth = Format(Sheets("InvoiceForm").Range("D5"), "mmm yyyy")
        nMth = Format(Sheets("InvoiceForm").Range("D5"), "mmm yyyy")
        nName = Sheets("MainForm").Range("B3").Value2 & "_" & Sheets("MainForm").Range("D3").Value2 & "_" & "Invoice"
        FilePath = Sheets("MainForm").Range("G3").Value & "\" & nMth
        FilePath2 = FilePath & "\" & nName & "_" & ReplaceAll(nMth, " ", "_") & ".xlsx"

        Application.ScreenUpdating = False

        On Error GoTo ErrCatcher
        .Visible = True
        .Activate
        ''/// don't need array
        '        Sheets(Array("InvoiceForm")).Copy
        .Copy
        On Error GoTo 0
        If FileFolderExists(FilePath) = False Then
            If _
                    MsgBox("File not found, do you wish to create a directory for" _
                         & " " & nMth & "?", vbYesNo, "Create New Directory") = _
                           vbYes Then
                CreateNewDirectory (FilePath2)
            End If
        End If

        UnlockSheets

        For Each ws In ActiveWorkbook.Worksheets
            ''/// copying the cells is better, you may not have anything selected
            With ws
                .Cells.Copy
                '            Selection.Copy
                .Cells(1, 1).PasteSpecial Paste:=xlPasteValues
                .Cells.Hyperlinks.Delete
                Application.CutCopyMode = False
                ''///not necessary
                '            Cells(1, 1).Select
                '            ws.Activate
            End With
        Next ws
        ''///not necessary
        'Cells(1, 1).Select
        FilePath3 = FilePath & "\" & nName & "_" & ReplaceAll(nMth, " ", "_")
        '/// you've already done this
        Sheets("InvoiceForm").Visible = True
        Sheets("InvoiceForm").Activate

        ActiveWorkbook.SaveCopyAs FilePath3 & ".xlsx"
        ActiveWorkbook.Close SaveChanges:=False
        Application.ScreenUpdating = True
    End With
    Exit Sub
    LockSheets
    Application.DisplayAlerts = False
ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"
End Sub

Open in new window

0
 

Author Closing Comment

by:Karen Schaefer
ID: 41734859
thanks for the clean up, this works great I was able to eliminate some other additional code to create the PDF by modifying your code

           ActiveWorkbook.SaveCopyAs FilePath3 & ".xlsx"
            ActiveWorkbook.SaveCopyAs FilePath3 & ".pdf"
0
 
LVL 21

Expert Comment

by:Roy Cox
ID: 41734882
Pleased to help
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question