Solved

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

Posted on 2016-07-27
6
39 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
PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

 
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

Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

Question has a verified solution.

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

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

832 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