Сохранить файл в месте, выбранном пользователем - PullRequest
Новая
       25

Сохранить файл в месте, выбранном пользователем

0 голосов
/ 08 января 2020

У меня есть файл, который будет заполнен третьей стороной. Файл должен быть проверен на формат для правильной загрузки в стороннее приложение.

Мой файл XLSM должен быть преобразован в CSV.

Я создал макрос следующим образом

  1. Выберите все ячейки, затем откройте новый лист Excel на диске, вставьте в него значение копии и сохраните его в виде файла csv, затем отправьте его по электронной почте

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

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

Sub Convertintocsvandsendoutlook()
'
'Convert into csv files from xlsm
'
Dim Path As String
Dim filename As String

Path = ""
filename = Range("B1") & Range("B3")

Windows("").Activate 'file name
Sheets("").Select ' sheets name
Cells.Select
Selection.Copy
Workbooks.Open ("XXX") 'path of the file
Range("a1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Columns("B:B").Select
Range("B2").Select
Selection.NumberFormat = "dd/mm/yyyy"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs filename:=Path & filename, FileFormat:=xlCSV
Application.DisplayAlerts = True

'Privacy warning à enlever
'Click on Excel Office Button
'Click on the Excel Options button
'Select the Trust Center tab
'Click on the Trust Center Settings… button
'Select the Privacy Options tab
'Uncheck the Remove personal information from file properties on save box
'Click OK twice

Call SendWorkBook
ActiveWorkbook.Close SaveChanges:=True

End Sub


Sub SendWorkBook()

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
On Error Resume Next
With OutlookMail
    .Display
    .HTMLBody = "XXXXX" & .HTMLBody
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = ActiveWorkbook.Name
    .Attachments.Add Application.ActiveWorkbook.FullName
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub
...