vba saving word file to created folder - vba

I have written the code below, currently it creates a folder. However I would like to save the same word doc to that folder. Any pointers on where I am going wrong??
Thanks
Sub newfold()
Dim strNewFolderName As String
strNewFolderName = "New Folder " & (Month(Now())) & " " & Year(Now)
If Len(Dir("c:\Users\Jabaar\Documents\" & strNewFolderName, vbDirectory)) = 0 Then
MkDir ("c:\Users\Jabaar\Documents\" & strNewFolderName)
End If
Dim PathName As String
PathName = ("New Folder " & MonthName(Month(Now())) & " " & Year(Now))
ActiveDocument.SaveAs "c:\Users\Jabaar\Documents\" & "(strNewFolderName)" + ".doc"
End Sub


Just replace
ActiveDocument.SaveAs "c:\Users\Jabaar\Documents\" & "(strNewFolderName)" + ".doc"
with
ActiveDocument.SaveAs FileName:="c:\Users\Jabaar\Documents\" & strNewFolderName & "\" & Split(ActiveDocument.Name, ".")(0) & ".doc", _
FileFormat:=wdFormatDocument
where Split(ActiveDocument.Name, ".")(0) takes current name of file without extension. You could replace it with desired name:
ActiveDocument.SaveAs FileName:="c:\Users\Jabaar\Documents\" & strNewFolderName & "\" & "newFile.doc", _
FileFormat:=wdFormatDocument


This is what have done and it seems work.
ActiveDocument.SaveAs "c:\Users\Jabaar\Documents\" & strNewFolderName & "\" & "test" + ".doc
The solution #simoco provided is what I was looking for, so thanks for confirming the formatting of it #simoco

Related

Access OutPutTo to folder

I have been struggling to output the PDF report to the relevant folder within the server. The error which is showing is
RunTime error 3201, no record found.
Could you please help me to solve it?
Dim RFQNumber As String
Dim InNumber As String
Dim FullReportName As String
Dim path1 As String
RFQNumber = [Forms]![RFQ_Database]![RFQ_ExNumber]
InNumber = [Forms]![RFQ_Database]![RFQ_InNumber]
path1 = "\\AZBAK-FP02\Work\Old Server Data\V&C\" & RFQNumber & "\" & RFQNumber & " " & InNumber & ".pdf"
MsgBox (path1)
DoCmd.OutputTo acOutputReport, "AOrderFCAVienna", "PDFFormat(*.pdf)", path1, False

I believe the ampersand in the directory path is causing the issue.
ath1 = "\\AZBAK-FP02\Work\Old Server Data\V&C\" & RFQNumber & "\" & RFQNumber & " " & InNumber & ".pdf"
^^^
you may need to add chr code
ath1 = "\\AZBAK-FP02\Work\Old Server Data\V" & Chr(38) & "C\" & RFQNumber & "\" & RFQNumber & " " & InNumber & ".pdf"
Inserting a formula containing an ampersand into a cell

Explanation on uploading files to share point using vba

I am trying to upload files to a sharepoint site, and for some reason something weird happens, where the first file with never upload, but a random amount of files after that will upload, and then sometimes an error of 'Getting list of available content types and properties' appears.
So 2 things that i need some help with, firstly how do i make it so the first file will upload, and then why am i sometimes getting the content error
here is the code i am using
If Dir("\\server\content\90002613\Documents\TestGB\" & saveFileName, vbDirectory) = "" Then
MkDir ("\\server\content\90002613\Documents\TestGB\" & saveFileName)
End If
If Dir("\\server\content\90002613\Documents\TestGB\" & saveFileName & "\" & Format(lDate, "yyyy"), vbDirectory) = "" Then
MkDir ("\\server\content\90002613\Documents\TestGB\" & saveFileName & "\" & Format(lDate, "yyyy"))
End If
If Dir("\\server\content\90002613\Documents\TestGB\" & saveFileName & "\" & Format(lDate, "yyyy"), vbDirectory) <> "" Then
With ActiveWorkbook
Application.ActiveWorkbook.SaveAs Filename:="https://server/content/90002613/Documents/TestGB/" & saveFileName & "/" & Format(lDate, "yyyy") & "\GB RSM P" & Format(lDate, "mm") & "FY" & Format(lDate, "yyyy") & " " & saveFileName & ".xlsx"
Application.ActiveWorkbook.Close False
End With
End If
thank you

You should be able to save to the UNC path:
Const BASE_DIR As String = "\\server\content\90002613\Documents\TestGB\"
Dim dt
If Dir(BASE_DIR & saveFileName, vbDirectory) = "" Then
MkDir (BASE_DIR & saveFileName)
End If
dt = Format(lDate, "yyyy")
If Dir(BASE_DIR & saveFileName & "\" & dt, vbDirectory) = "" Then
MkDir (BASE_DIR & saveFileName & "\" & dt)
End If
With ActiveWorkbook
.SaveAs Filename:="BASE_DIR " & saveFileName & "\" & dt & _
"\GB RSM P" & Format(lDate, "mm") & "FY" & _
Format(lDate, "yyyy") & " " & saveFileName & ".xlsx"
.Close False
End With

Save a single worksheet as CSV/xlsx file error 1004 (but does work when use 'export as fixed format' for PDF)

I have managed to get this to save as a PDF using 'ExportAsFixedFormat', but when I try to use 'SaveAs' to get a CSV (although I would accept xlsx too!) I get:
Run time error: 1004 Application defined or Object defined error
I have spent way to long trying to do this and can't find any answers that work for me online...
Sub SaveTrackingSheet()
Dim NewPathTrack As String
NewPathTrack = Application.ThisWorkbook.Path & "\PDF Outputs\" & Range("NameTrack").Text & "\"
If Dir(NewPathTrack, 63) = "" Then MkDir NewPathTrack
Dim NewPathDealer As String
NewPathDealer = NewPathTrack & Range("CodeTrack").Text & " - " & Range("NameTrack").Text & "\"
If Dir(NewPathDealer, 63) = "" Then MkDir NewPathDealer
Sheets("Tracking Sheet").SaveAs _
Filename:=NewPathDealer & "\" & Range("CodeTrack").Text & " - Tracking Sheet" & ".csv", _
FileFormat:=xlCSV, _
ConflictResolution:=2, _
Local:=True, _
CreateBackup:=False
End Sub
This is the line that errors:
Sheets("Tracking Sheet").SaveAs _
Filename:=NewPathDealer & "\" & Range("DealerCodeTrack").Text & " - Tracking Sheet" & ".csv", _
FileFormat:=xlCSV, _
ConflictResolution:=2, _
Local:=True, _
CreateBackup:=False
Thanks in advance!

fileformat:=xlCSVMSDOS
Check fileformat specifications at https://msdn.microsoft.com/es-es/vba/excel-vba/articles/xlfileformat-enumeration-excel
UPDATED RIGHT NOW:
The code that works for me is:
Sub SaveTrackingSheet()
Dim NewPathTrack As String
NewPathTrack = Application.ThisWorkbook.Path & "\PDF Outputs\" & Range("NameTrack").Text & "\"
If Dir(NewPathTrack, 63) = "" Then MkDir NewPathTrack
Dim NewPathDealer As String
NewPathDealer = NewPathTrack & Range("CodeTrack").Text & " - " & Range("NameTrack").Text & "\"
If Dir(NewPathDealer, 63) = "" Then MkDir NewPathDealer
Sheets("Tracking Sheet").SaveAs _
Filename:=NewPathDealer & Range("CodeTrack").Text & " - Tracking Sheet" & ".csv", _
FileFormat:=xlCSV, _
Local:=True, _
CreateBackup:=False
'ConflictResolution:=2 This line causes the error
End Sub
Hope it helps!

Save version of file to drive, when the drive changes from computer to computer

I made a macro to export my xlsm file into a csv file. It works great on one computer where the directory of the server is "I" but on another computer with the same server saved to directory "T" it fails. Is there a solution to this multi-directory/multi-computer problem? The trimmed code is attached with the directory line pointed out.
Sub ExportAsCSV()
Dim Answer As VbMsgBoxResult, Dir As String, LastRow As Long, _
Date1 As Date, Date2 As Date, CSVFileName As String
' *********************************************************
' Directory String <---------------- The Issue
Dir = "I:\2017\CVS" ' Could be "I:\", could be "T:\" ...
' *********************************************************
' Creating the Name of the CSV File using the _
' first and last date in column C (C1 is a header)
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
Date1 = Range("C2").Value
Date2 = Cells(LastRow, "C")
If Date1 < Date2 Then
CSVFileName = "FILE." & Format(Date1, "mm.dd.yy") & _
"-" & Format(Date2, "mm.dd.yy") & ".csv"
ElseIf Date1 > Date2 Then
CSVFileName = "FILE." & Format(Date2, "mm.dd.yy") & _
"-" & Format(Date1, "mm.dd.yy") & ".csv"
Else
CSVFileName = "FILE." & Format(Date1, "mm.dd.yy") & ".csv"
End If
' Double Check User wants to make a sheet Response
Answer = MsgBox("Clicking 'Yes' will create a CSV file named " & vbCrLf & vbCrLf & _
" " & CSVFileName & vbCrLf & vbCrLf & _
"into " & vbCrLf & vbCrLf & " " & Dir & vbCrLf & vbCrLf & _
"It will overwrite any CSV with an identical name." & vbCrLf & vbCrLf & _
"Is this what you want to do?", vbYesNo + vbQuestion)
'Act based on the Response
If Answer = vbYes Then
' Ready all cells for csv creation
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")
ws.Copy
ActiveWorkbook.SaveAs FileName:=Dir & "\" & CSVFileName, _
FileFormat:=xlCSV, CreateBackup:=False
MsgBox ("Created the csv file:" & vbCrLf & vbCrLf & _
Dir & "\" & CSVFileName)
Else
MsgBox ("Did not create the csv file.")
End If
End Sub
Any help is appreciated.

You need to use a UNC path instead of a mapped network drive.
Dir = "\\ServerName\SomeFolder\2017\CVS"
If you don't know what server/folder the network drive is pointing to, ask your network administrator.
Side note
You shouldn't name things in ways that hide/shadow identifiers that already exist in global namespace: Dir is actually a function in the VBA.FileSystem module; by declaring a Dir local variable, you make the name potentially ambiguous to the reader (although the compiler doesn't care).

Excel VBA Save path/name from cells with variables

I am using cells as the file path and filename to save a copy of my workbook.
Here's the code am using now but it puts spaces in between each cell.
Note only the ActiveSheet.Range cells will have the possibility of being blank
Dim NewWb As Workbook
sFile = Control_Sheet_VB.Range("H2") & "\" & ActiveSheet.Range("H8") & " " & ActiveSheet.Range("E10") & " " & ActiveSheet.Range("D14") & " - Ticket #" & Control_Sheet_VB.Range("B2") & Control_Sheet_VB.Range("C2") & ".xlsm"
Set OldWb = ActiveWorkbook
OldWb.SaveCopyAs sFile
Set NewWb = Workbooks.Open(sFile)
How can I make it so if some of the cells that are used as the file name are blank then it dose not put the extra space in the filename

you may go like this:
sFile = Control_Sheet_VB.Range("H2") & "\" & _
IIf(ActiveSheet.Range("H8") <> "", ActiveSheet.Range("H8") & " ", "") & _
IIf(ActiveSheet.Range("E10") <> "", ActiveSheet.Range("E10") & " ", "") & _
IIf(ActiveSheet.Range("D14") <> "", ActiveSheet.Range("D14") & " ", "") & _
" - Ticket #" & Control_Sheet_VB.Range("B2") & _
Control_Sheet_VB.Range("C2") & ".xlsm"