Change export from .txt to workbook

[StellarRumble59]

Hi All

I have the below in a very old macro that we need to change to export the sheet as is (for now)

How do we change the below so it exports as a worksheet only?


' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Private Sub Button_CreateTXTFile_Click()
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

' ***************
' Step 3 - Create TXT File
' Code creates a txt file and inserts the import text and then saves as "KeanuImport - DDMMYY-HHMMSS"
' file is saved in the C Drive ready for importing to Hirum
' ***************

' Request destination for file to be saved
FNameAppend = Now()
FNameAppend = Format(FNameAppend, "ddmmyy-hhmmss")

ApolloImportPath = Application.GetSaveAsFilename("ApolloImport-" & FNameAppend, _
"Text Documents (*.txt),*.txt")

' Write to text file

ImportRowi = 1
ImportColumnj = 1

Sheets("IMPORT").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select

' Selection.Copy - REDUNDANT CODE


FName = ApolloImportPath
FNum = FreeFile

Open FName For Append Access Write As #FNum

Do While ImportRowi <= Selection.Rows.Count
ImportColumnj = 1
Do While ImportColumnj <= Selection.Columns.Count

Print #FNum, Selection.Cells(ImportRowi, ImportColumnj)
ImportColumnj = ImportColumnj + 1
Loop
ImportRowi = ImportRowi + 1
Loop

Close #FNum

' Make changes to the user form to prepare for next step

MsgBox "Your import file has been created and saved directly to... " & vbNewLine & vbNewLine & ApolloImportPath _
& vbNewLine & vbNewLine & "The next part of the import process takes place in Hirum.." & _
" use the import hotel system in the toolbox to find the file and import it."

Button_CreateTXTFile.Enabled = False
Label_ImportSucess.Caption = "STOP!! The next part of the process occurs in Hirum. Do not proceed until the ApolloImport file has been sucessfully imported to Hirum"
Label_ImportSucess.BackColor = RGB(255, 255, 153)
Button_OK.Enabled = True

Label_Created.Caption = "File location: " & vbNewLine & ApolloImportPath
Me.Label_ImportSucess.TextAlign = fmTextAlignCenter
Me.Label_Created.TextAlign = fmTextAlignCenter

Me.Button_OK.SetFocus
Me.Button_Abort.Visible = False
Me.Button_AbortPostHirum.Visible = True
Me.Button_PrintImport.Enabled = False

End Sub

Any help would be greatly appreciated.

 

[HighAndWilder]

This code will copy the IMPORT worksheet to a new workbook and save and close the workbook.

You need to declare the ApolloImportPath variable as variant.

Dim ApolloImportPath As Variant

  Worksheets("IMPORT").Copy
    
  ApolloImportPath = Application.GetSaveAsFilename("ApolloImport-" & Format(Now(), "ddmmyy-hhmmss"), _
    "Excel Workbook (*.xlsx),*.xlsx")
    
  If ApolloImportPath = False Then
    Exit Sub
  End If
      
  With ActiveWorkbook
    .SaveAs ApolloImportPath
    .Close False
  End With