Make New Directory Workbook VBA

Threshold

New Member
Joined
May 26, 2017
Messages
33
Hi All,

So I have this code:

Code:
Sub SaveFilewithNewName()    Dim NewFN As Variant
    Dim NewPth As String
    Dim WRK2 As Workbook
    PostToRegister
    'Copy File to New Path and Filename
    ActiveSheet.Copy
    'Change File Path to Server File Path when ready
    NewPth = "E:\NewProject\File\" & Range("K3")
    MkDir NewPth
    NewFN = NewPth & "\" & Range("K3").Value & ".xlsx"
    ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close
    NextFile
End Sub

Currently I get the error at MkDir NewPth, NewPth doesn't seem to add the K3 Range... even though when I hover over the name it shows the value for the Range, but doesn't show it as part of NewPth.

Thanks in advance
 
Last edited:

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
What error do you get & what is the value in K3?
 
Upvote 0
"Run-Tem error '75':
Path/File access error"

Value is 26 (it'll usually be a number)
I had it working once before, but Some files got deleted and I can't remember what I had done differently
 
Upvote 0
Can you manually add a new directory to that path?
 
Upvote 0
Add the line in blue to your code
Code:
    NewPth = "E:\NewProject\File\" & Range("K3")
   [COLOR=#0000ff] MsgBox NewPth[/COLOR]
    MkDir NewPth
does the msgbox show the path you are expecting?
 
Upvote 0
At the moment you are reading K3 on the active sheet (ie the sheet that has been copied) is that where you need to look, or should it be looking at another sheet?
 
Upvote 0
Getting confused by the code a little, below is my entire code...Not sure which one it thinks is active...

Code:
Sub PostToRegister()    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
    Set WS1 = Worksheets("Sheet A")
    'Set WS2 = Worksheets("FileLog")
    Dim WBK As Workbook
    Set WBK = Workbooks.Open("E:\Projects\File\File-TEST.xlsm")
    Set WS2 = Worksheets("A")
    Dim CurFile As Variant
    Dim NextFile As Variant
    'WBK.
    CurECO = WS2.Range("A" & Rows.Count).End(xlUp).Value
    NextFile = CurFile + 1
    
    'Figure out which row is next row
    NextRow = WS2.Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    'Write the important value to FileLog
    WS2.Cells(NextRow, 1).Resize(1, 3).Value = Array(WS1.Range("K3"), Date, WS1.Range("B31"))


End Sub
Sub NextFile()
    Range("K3").Value = Range("K3").Value + 1
    Range("Sheet").MergeArea.ClearContents
    Range("RevInt").MergeArea.ClearContents
    Range("RevFin").MergeArea.ClearContents
    Range("Orig").MergeArea.ClearContents
    Range("DWGNo").MergeArea.ClearContents
    Range("DWGTitle").MergeArea.ClearContents
    Range("NextAssy").MergeArea.ClearContents
    Range("Desc").MergeArea.ClearContents
    Range("QTY").MergeArea.ClearContents
    Range("STKLoc").MergeArea.ClearContents
    Range("STKRem").MergeArea.ClearContents
    Range("JobNo").MergeArea.ClearContents
    Range("FoldPull").MergeArea.ClearContents
    Range("CCon").MergeArea.ClearContents
    Range("B31:M39").ClearContents
End Sub


Sub SaveProjectswithNewName()
    Dim NewFN As Variant
    Dim NewPth As String
    Dim WRK2 As Workbook
    PostToRegister
    'Copy Projects to New Path and Filename
    ActiveSheet.Copy
    'Change File Path to Server File Path when ready
    NewPth = "E:\Projects\File\" & Range("K3").Value
    MsgBox NewPth
    MkDir NewPth
    NewFN = NewPth & "\" & Range("K3").Value & ".xlsx"
    ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close
    NextFile
End Sub
 
Upvote 0
Change the msgbox to
Code:
MsgBox Range("K3").value
What does it give?
 
Upvote 0

Forum statistics

Threads
1,224,827
Messages
6,181,200
Members
453,022
Latest member
RobertV1609

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top