Make New Directory Workbook VBA

[Threshold]

Hi All,

So I have this 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

 

[Fluff]

What error do you get & what is the value in K3?

 

[Threshold]

"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

 

[Fluff]

Can you manually add a new directory to that path?

 

[Threshold]

yes I can

 

[Fluff]

Add the line in blue to your code

    NewPth = "E:\NewProject\File\" & Range("K3")
   [COLOR=#0000ff] MsgBox NewPth[/COLOR]
    MkDir NewPth

does the msgbox show the path you are expecting?

 

[Threshold]

seems to be missing the 26 in this case, so it reads

"E:\NewProject\File"

and thats it

 

[Fluff]

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?

 

[Threshold]

Getting confused by the code a little, below is my entire code...Not sure which one it thinks is active...

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

 

[Fluff]

Change the msgbox to

MsgBox Range("K3").value

What does it give?