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

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

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

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

Два вопроса:

  1. Можете ли вы предложить варианты решения проблемы с сохранением как?

  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

excel vba excel-2010
person user2124731    schedule 01.03.2013    source источник

Ответы (3)


arrow_upward
3
arrow_downward

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

FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
person Stewbob    schedule 01.03.2013

arrow_upward
0
arrow_downward

Чтобы перебрать все файлы в папке, у вас есть два варианта.

  1. Используйте встроенную функцию VBA Dir.
  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
person Tmdean    schedule 01.03.2013

arrow_upward
0
arrow_downward

У вас есть две переменные 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")

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

person barrowc    schedule 02.03.2013