Сохранение * .asc файлов в виде файлов Excel

Question

У меня есть * .asc файлы для открытия, переформатирования и сохранения в виде файла Excel с тем же именем, что и оригинал (с расширением xls).

Я использовал Macro Recorder и код, который я нашел в Интернете, чтобы открыть отдельные файлы и переформатировать их по своему усмотрению. Эта часть кода работает.

Я не могу сохранить файл Excel. Это дает мне Run Time error of 1004 Method ‘SaveAs’ of object ‘_Workbook’ failed. Я пробовал много разных кодов, которые я нашел онлайн (все еще там, только что прокомментировал), но никто не работает.

Два вопроса:

1. Вы можете вносить свои предложения, чтобы исправить эту проблему SaveAs?

2. Можете ли вы предложить предложения о том, как автоматизировать открытие и сохранение всех файлов в одной папке?

Вот код, у меня есть:

Sub OpenFormatSave() 
' 
' OpenFormatSave Macro 
' 

Dim StrFileName As String 
Dim NewStrFileName As String 
    ChDir _ 
     "C:\Users\Owner\Documents\work_LLRS\GoM\NASA_data\Satellite_files_GoM_3Dec2012" 
    StrFileName = Application.GetOpenFilename("NASA Files (*.asc), *.asc") 
    If TypeName(StrFileName) <> "Boolean" Then 
     Workbooks.OpenText Filename:=StrFileName, _ 
     Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ 
     xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _ 
     Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _ 
     Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _ 
     Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True 
    End If 
    Rows("1:1").Select 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Range("A1").Select 
    ActiveCell.FormulaR1C1 = "Year" 
    Range("B1").Select 
    ActiveCell.FormulaR1C1 = "Day_of_Year" 
    Range("C1").Select 
    ActiveCell.FormulaR1C1 = "Longitude" 
    Range("D1").Select 
    ActiveCell.FormulaR1C1 = "Latitude" 
    Range("E1").Select 
    ActiveCell.FormulaR1C1 = "Chla_mg_m-3" 
    Range("F1").Select 
    ActiveCell.FormulaR1C1 = "POC_mmolC_m-3" 
    Range("G1").Select 
    ActiveCell.FormulaR1C1 = "SPM_g_m-3" 
    Range("H1").Select 
    ActiveCell.FormulaR1C1 = "aCDOM355_m-1" 
    Range("I1").Select 
    ActiveCell.FormulaR1C1 = "DOC_mmolC_m-3" 
    Range("J1").Select 
    ActiveCell.FormulaR1C1 = "L2_flags" 

    Columns("A:B").Select 
    Selection.NumberFormat = "0" 
    Columns("C:D").Select 
    Selection.NumberFormat = "0.0000" 
    Columns("E:E").Select 
    Selection.NumberFormat = "0.000" 
    Columns("F:F").Select 
    Selection.NumberFormat = "0.0" 
    Columns("G:H").Select 
    Selection.NumberFormat = "0.000" 
    Columns("I:I").Select 
    Selection.NumberFormat = "0.0" 
    Columns("J:J").Select 
    Selection.NumberFormat = "0.00E+00" 



'Mid(StrFileName, 1, InStrRev(StrFileName, ".")) = "xlsm" 

'With ActiveWorkbook 
    'NewStrFileName = Replace(.StrFileName, ".asc", ".xls") 
    ' .SaveAs Filename:=FullName, FileFormat:=xlsx, AddToMRU:=False 
    ' .Close SaveChanges:=True 
'End With 

StrFileName = ThisWorkbook.Name 
GetName: 
StrFileName = Application.GetSaveAsFilename(NewStrFileName, _ 
    fileFilter:="(*.xlsm), *.xlsm, (*.xlsx), *.xlsx,(*.xls), *.xls") 

' FileMonth is the Workbook name, filter options to save a older version file 
'If Dir(NewStrFileName) = "" Then 
' ActiveWorkbook.SaveAs NewStrFileName 
'Else 
' If MsgBox("That file exists. Overwrite?", vbYesNo) = vbNo Then GoTo GetName 
    ' Application.DisplayAlerts = False 
    ' ActiveWorkbook.SaveAs Filename:=NewStrFileName, FileFormat:=xlsx, AddToMRU:=False 
    'Application.DisplayAlerts = True 
'End If 
    'ActiveWorkbook.Close SaveChanges:=True 


ActiveWorkbook.SaveAs Filename:=NewStrFileName, FileFormat:=xlsx, CreateBackup:=False 

'With ThisWorkbook 
    'FullName = Replace(.StrFileName, ".asc", ".xlsx") 
    '.Save 
    '.SaveAs StrFileName, FileFormat:=xlsx 
    '.Close 
    'SaveChanges:=True 
'End With 



'StrFileName = Split(ActiveWorkbook.FullName, ".xls")(0) 

'ActiveWorkbook.SaveAs Filename:="...", FileFormat:=xlsx, AddToMRU:=False 
'ActiveWorkbook.Close SaveChanges:=True 

'ActiveWorkbook.Save 
End Sub 

Answer 1

Изменение FileFormat часть вашего метода SaveAs к этому:

FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 

Answer 2

Для перебора всех файлов в папке, имеют два варианта.

1. Используйте built-in VBA Dir function.
2. Способы использования: FileSystemObject.

Я приведу пример Dir, потому что он не требует добавления ссылки в проект VBA. К сожалению, интерфейс Dir намного менее интуитивно понятен и менее современен, чем FileSystemObject.

Dim path As String 

path = Dir("C:\Users\example\Documents\AscFiles\*.asc") 
Do 
    If path = vbNullString Then Exit Do 

    ' do something with path here 
    Debug.Print path 

    path = Dir 
Loop 

Answer 3

У вас есть две переменные StrFileName (предположительно предназначенные в качестве текущего файла) и NewStrFileName (предположительно предназначены для нового файла).

В этом фрагменте кода:

StrFileName = Application.GetSaveAsFilename(NewStrFileName, _ 
    fileFilter:="(*.xlsm), *.xlsm, (*.xlsx), *.xlsx,(*.xls), *.xls") 

вы использовали эти переменные навыворот. Предлагаемое имя файла, когда открывается диалоговое окно «Сохранить как», основано на NewStrFileName, но это никогда не давалось значения и, следовательно, пустая строка "". Значение, выбранное пользователем, а затем сохраняется в StrFileName

Когда вы приходите, чтобы сохранить файл с этим кодом:

ActiveWorkbook.SaveAs Filename:=NewStrFileName, FileFormat:=xlsx, _ 
    CreateBackup:=False 

переменная NewStrFileName еще содержит "" и, таким образом, вы пытаетесь сохранить файл, не давая это имя, которое явно порождает ошибку.

Для простого исправления, просто поменять местами две переменные в вызове GetSaveAsFilename:

NewStrFileName = Application.GetSaveAsFilename(StrFileName, _ 
    fileFilter:="(*.xlsm), *.xlsm, (*.xlsx), *.xlsx,(*.xls), *.xls") 

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