vba Workbook.Save сохраняет в другой каталог

Question

Я открываю существующий файл xlsx и добавляю новый рабочий лист. Тогда я просто хочу сохранить файл.

Dim wb As Workbook 
Dim ws As Worksheet 

Set wb = Workbooks.Open(fileName:=pathToFile, Editable:=True, ReadOnly:=False) 
Set ws = wb.Worksheets.Add() 
ws.Name = "newSheet" 
ws.range("A1").CopyFromRecordset rs 

wb.Save 
wb.Close 

Но wb.Save сохраняет файл в $ Users \ Документы, хотя это не исходный каталог, откуда я открыть файл.

Любые идеи, почему VBA это делает?

Я также пробовал wb.SaveAs pathToFile, но это вызвало ошибку. И wb.Close SaveChanges: = True тоже не работает.

Мне нужно сохранить этот файл по тому же пути и имени.

Конечно, я мог бы сделать wb.SaveAs pathToFile & «_tmp», удалить старый и переименовать новый файл. Но почему Save не работает?

EDIT

Dim strCon As String: strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=path\file.xlsx;Mode=Read;Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";" 
Dim sql as String 
Dim cn As ADODB.Connection 
Dim rs As ADODB.Recordset 

Set cn = CreateObject("ADODB.Connection") 
Set rs = CreateObject("ADODB.Recordset") 

cn.Open strCon 
rs.Open Source:=sql, ActiveConnection:=cn 

Dim wb As Workbook 
Dim ws As Worksheet 
Set wb = Workbooks.Open(fileName:=path\file.xlsx, ReadOnly:=False) 
Set ws = wb.Worksheets.Add() 
ws.Range("A1").CopyFromRecordset rs 

rs.Close 
cn.Close 

wb.Save 
wb.Close 

Answer 1

Попробовав вокруг в течение нескольких часов и с неустанной поддержкой Оскара (см комментариев. Большое спасибо!) Решением этой проблемы, чтобы загрузить книгу, как предложено в here (Спасибо Оскару). Тем не менее книга будет открыта как ReadOnly. Чтобы изменить это, просто измените режим FileAccess, установив wb.ChangeFileAccess xlReadWrite.

Код выше теперь выглядит следующим образом:

Dim strCon As String: strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=path\file.xlsx;Mode=Read;Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";" 
Dim sql as String 
Dim cn As ADODB.Connection 
Dim rs As ADODB.Recordset 

Set cn = CreateObject("ADODB.Connection") 
Set rs = CreateObject("ADODB.Recordset") 

cn.Open strCon 
rs.Open Source:=sql, ActiveConnection:=cn 

Dim wb As Workbook 
Dim ws As Worksheet 
Workbooks.Open Filename:=file.xlsx ' <-- Look here 
Set wb = Workbooks("file.xlsx")  ' <-- And here 
Set ws = wb.Worksheets.Add() 
ws.Range("A1").CopyFromRecordset rs 

rs.Close 
cn.Close 

wb.ChangeFileAccess xlReadWrite  ' <-- And here 
wb.Save 
wb.Close 

Однако это еще не ясно, почему VBA изменяет путь книги в каталог пользователей документов, если опустить wb.ChangeFileAccess xlReadWrite.

EDIT

Хотя рефакторинга мой код я заметил что-то больше относительно использования WorkBook.ChangeFileAccess. Если вы создаете ADODB.Connection в том же Sub, вам необходимо изменить доступ к файлу xlReadWrite, как описано выше. Но если вы написали функцию, которая получает переданную строку соединения и SQL-запрос, который будет выполняться, а затем создает соединение ADODB, то изменение доступа к файлу в книге приведет к ошибке.

Пример:

Public Function ExecSql(conn as String, sql as String) As Recordset 
    Dim recSet As Recordset 
    Dim cn As ADODB.Connection 
    Dim rs As ADODB.Recordset 

    Set cn = CreateObject("ADODB.Connection") 
    cn.Mode = adModeReadWrite 
    cn.Open conn 

    Set rs = CreateObject("ADODB.Recordset") 
    rs.Open Source:=sql, ActiveConnection:=cn 

    Set recSet = rs 
    Set ExecQuery = recSet 
End function 

И в вызывающем Суб:

Dim conn As String: conn = "" ' connection String, see above 
    Dim sql As String: sql = "" ' the query 

    ' Open workbook here like above 

    Dim rs As Recordset: Set rs = ExecSql(strCon, sql) 
    ws.Range("A1").CopyFromRecordset rs 

    rs.Close 

    ' wb.ChangeFileAccess xlReadWrite  ' not needed 
    wb.Save 
    wb.Close 

Не забудьте позвонить rs.Close в вызывающей подпрограмме и не в функции ExecSQL (см второй и третий ответ here)

Другое: вам нужно позвонить в ExecSql ПОСЛЕ открытия книги. Если ExecSql выполняется до того, как он не сохранит изменения.