Сохранение таблицы Excel в формате .txt

Question

Я новичок в VBA. Поэтому у меня есть задача, где я должен сохранить лист Excel с 1 конкретной строкой в ​​формате .txt.

На данный момент я знаю, как сохранить его только в определенном направлении (например, рабочий стол).

Но есть ли у пользователя способ выбрать с помощью всплывающего окна (например, как сохранить как), где он хочет его сохранить?

Private Sub CommandButton2_Click()

Dim fso As Object

strPath = "C:\Users\" & Environ("UserName") & "\Desktop\"
strFolderName = "Atskaites"
strFullPath = strPath & strFolderName & "\"

If Dir(strPath & strFolderName, vbDirectory) = "" Then
    MkDir strFullPath
End If

Set fso = CreateObject("Scripting.FileSystemObject") 'teksta faila izveidosana
Dim Fileout As Object
Set Fileout = fso.CreateTextFile(strFullPath & TextBox1.Text & ".txt", True, True)  'kur izveidot un kada formata    Fileout.Visible = True

Fileout.WriteLine "Klients:"
Fileout.WriteLine (TextBox1.Text)
Fileout.WriteLine "06.17"
Fileout.WriteLine (TextBox2.Text)
Fileout.WriteLine "07.17"
Fileout.WriteLine (TextBox3.Text)
Fileout.WriteLine "08.17"
Fileout.WriteLine (TextBox4.Text)
Fileout.WriteLine "09.17"
Fileout.WriteLine (TextBox5.Text)
Fileout.WriteLine "10.17"
Fileout.WriteLine (TextBox6.Text)
Fileout.WriteLine "Kopa"
Fileout.WriteLine (TextBox7.Text)

MsgBox ("Saved")

Fileout.Close

End Sub

Answer 1

Есть много способов сделать это. Пример кода ниже только один способ. Поскольку вы говорите, что хотите сохранить строку данных, сначала вас попросят выбрать строку, затем спросит, в каком каталоге вы хотите ее сохранить, затем она скопирует эту строку в новую книгу и, наконец, сохранит эту книгу кактекстовый файл в этом каталоге.

Конечно, вам нужно изменить его для вашей конкретной ситуации. Это только для того, чтобы вы начали с чего-то, что работает.

Option Explicit
Sub saveRow()
Dim theDir As String
Dim sh As Worksheet, wk As Workbook, r As Range
Set r = Application.InputBox("select the row to export", , , Type:=8)
theDir = folderFromUser("C:/") 'C: is just the default location
Set wk = Workbooks.Add
r.Worksheet.Rows(r.row).Copy
ActiveSheet.Paste
wk.SaveAs theDir & "\test.txt", XlFileFormat.xlUnicodeText
Application.DisplayAlerts = False
wk.Close False
Application.DisplayAlerts = True
End Sub

Function folderFromUser(initialPath As String) As String
Dim fd As FileDialog, ButtonClickedByUser As Boolean, msg As String
On Error GoTo ErrorHandler
  Set fd = Application.FileDialog(msoFileDialogFolderPicker) 'see also msoFileDialogFilePicker
  fd.AllowMultiSelect = False
  fd.InitialFileName = Left(initialPath, InStrRev(initialPath, "\"))
  ButtonClickedByUser = fd.Show
  If ButtonClickedByUser = False Then Exit Function
  folderFromUser = fd.SelectedItems(1)
Exit Function
ErrorHandler:
MsgBox "Error # " & Str(Err.Number) & " was generated by " & Err.Source & Chr(13) _
  & Err.Description, , "Error in folderFromUser routine", Err.HelpFile, Err.HelpContext
Err.Clear
End Function