简体   繁体   中英

VBA save in folder based on cell value

How do I save a file to a specific folder?

I save a file like this:

ActiveWorkbook.SaveAs Range("AG1").Value

I have a cell-value for the folder name in AH1

I tried to add Range("AH1"), but that give a 1004 error

ActiveWorkbook.SaveAs Range("AH1") & "\" & Range("AG1").Value

This is my whole code

Sub ImportCSV_SaveTXT_Loop()
'Updateby Extendoffice
    Dim xFileName As Variant
    Dim Rg As Range
    Dim xAddress As String

    
    Workbooks.Open "D:\Downloads\macroLynred\template_xxxxxx-xxx.xlsx"
    Sheets("template").Select
    
    myPath2 = "D:\Downloads\macroLynred\csv\" ' ThisWorkbook.Path & "\"
    xFileName = Dir(myPath2 & "*.csv")
    
    ChDrive "D:"
    ChDir "D:\Downloads\macroLynred\csv"
    
    While xFileName <> ""
    
        'xFileName = Application.GetOpenFilename("CSV File (*.csv), *.csv", , "Kutools for Excel", , False)
        If xFileName = False Then Exit Sub
        On Error Resume Next
        Set Rg = Range("$A$1")
        'Set Rg = Application.InputBox("please select a cell to output the data", "Kutools for Excel", Application.ActiveCell.Address, , , , , 8)
        On Error GoTo 0
        If Rg Is Nothing Then Exit Sub
        xAddress = Rg.Address
        With ActiveSheet.QueryTables.Add("TEXT;" & xFileName, Range(xAddress))
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 936
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        
        ActiveWorkbook.SaveAs Range("AG1").Value
   
        
        
        Sheets("sinfwafermap").Select
        
        Dim WB As Workbook: Set WB = ActiveWorkbook
        Dim myPath As String, myFile As String, myFolder As String
        
        myFolder = WB.ActiveSheet.Range("B2").Value
        myPath = ThisWorkbook.Path & "\csv\" & myFolder & "\"
        myFile = WB.ActiveSheet.Range("B1").Value
    
        'Dim WB As Workbook: Set WB = ThisWorkbook
        
        Debug.Print myPath
        Debug.Print myFolder
        
        Application.ScreenUpdating = False
        WB.ActiveSheet.Copy  'a new workbook is created
        ActiveSheet.UsedRange.Offset(, 1).Clear 'let only A:A column content
        ActiveSheet.UsedRange.Offset(33).Clear  'clear rows below 32
        With ActiveWorkbook
            Application.DisplayAlerts = False
            .SaveAs Filename:=myPath & myFile, FileFormat:=xlText
            .Close True
            Application.DisplayAlerts = True
        End With
        
        Application.ScreenUpdating = True
        
        Workbooks.Open "D:\Downloads\macroLynred\template_xxxxxx-xxx.xlsx"
        Sheets("template").Select
        
        xFileName = Dir()
    Wend
    Workbooks.Close
    MsgBox "Ready..."
End Sub

You are trying to save your file as a Macro-Free Workbook, but you need to save it as a Macro-Enabled one.

Change this line:

ActiveWorkbook.SaveAs Range("AG1").Value

To:

ActiveWorkbook.SaveAs (Range("A1").Value), FileFormat:=xlOpenXMLWorkbookMacroEnabled

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM