Solved

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

Posted on 2016-07-27
6
44 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 19

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
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!

 
LVL 19

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 19

Expert Comment

by:Roy_Cox
ID: 41734882
Pleased to help
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say 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

Suggested Solutions

Title # Comments Views Activity
Desktop in File-open on Excel 7 34
Tricky shapes formula part 2 4 21
Word 2010 VBA - Search, Select and Delete macro 8 26
Would like to change date on excel 6 17
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

749 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