Solved

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

Posted on 2016-07-27
6
41 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
  • 3
  • 3
6 Comments
 
LVL 18

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
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
LVL 18

Accepted Solution

by:
Roy_Cox earned 500 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 18

Expert Comment

by:Roy_Cox
ID: 41734882
Pleased to help
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

856 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