将 *.asc文件保存为Excel文件

xxe27gdn  于 2023-01-18  发布在  其他
关注(0)|答案(4)|浏览(2493)

我有 *.asc文件要打开、重新格式化,然后保存为与原始文件同名的Excel文件(扩展名为xls)。
我使用宏记录器和我在网上找到的代码打开单个文件并根据需要重新格式化它们。那部分代码起作用了。
我不能保存为Excel文件。它给了我Run Time error of 1004 Method ‘SaveAs’ of object ‘_Workbook’ failed。我试过很多不同的代码,我在网上找到(仍然在那里,只是注解掉),但没有工作。
两个问题:
1.您能否提供解决“另存为”问题的建议?
1.你能提供建议如何自动打开和保存在一个文件夹中的所有文件?
下面是我的代码:

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
inn6fuwd

inn6fuwd1#

将SaveAs方法的FileFormat部分更改为:

FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
bfhwhh0e

bfhwhh0e2#

要循环访问文件夹中的所有文件,有两个选项。
1.使用built-in VBA Dir function
1.使用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
azpvetkf

azpvetkf3#

您有两个变量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")

这不是达到你想要的最好的方法,但至少它应该起作用

xtfmy6hx

xtfmy6hx4#

这是一个非常简单的代码,可以将ASC文件转换为Excel文件。2它也可以处理CSV文件。3所以你所要做的就是将.asc文件转换为.csv文件。4只要确保你将分隔符设置为TAB,无论你从哪里获取数据。

Sub import_ascFile()

    Dim file As FileDialog
    Dim filePath As String
    Dim text As String
    Dim wsheet As String
    
    Application.DisplayAlerts = False
    Application.StatusBar = True
    
    wsheet = ActiveWorkbook.Name
    
    Set file = Application.FileDialog(msoFileDialogFolderPicker)
    file.Title = "Folder Selection:"
    
    If file.Show = -1 Then
        filePath = file.SelectedItems(1)
        Else
        Exit Sub
    End If
    
    If Right(filePath, 1) <> "\" Then filePath = filePath + "\"
        text = Dir(filePath & "*.asc")
    
    Do While text <> ""
        Application.StatusBar = "Converting: " & text
        Workbooks.Open Filename:=filePath & text
        ActiveWorkbook.SaveAs Replace(filePath & text, ".asc", ".xlsx", vbTextCompare), xlWorkbookDefault
        ActiveWorkbook.Close
        Windows(wsheet).Activate
        text = Dir
    Loop
    
    Application.StatusBar = False
    Application.DisplayAlerts = True
End Sub

相关问题