• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 66
  • Last Modified:

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

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
Karen Schaefer
Asked:
Karen Schaefer
  • 3
  • 3
1 Solution
 
Roy CoxGroup Finance ManagerCommented:
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
 
Karen SchaeferBI ANALYSTAuthor Commented:
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
 
Karen SchaeferBI ANALYSTAuthor Commented:
Thanks Roy for your input found solution within my existing code.
0
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

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.

 
Roy CoxGroup Finance ManagerCommented:
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
 
Karen SchaeferBI ANALYSTAuthor Commented:
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
 
Roy CoxGroup Finance ManagerCommented:
Pleased to help
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now