Создание НОВЫХ файлов и папок

Question

Sub Test()
Dim myDir As String
Dim Folder1 As String

StartDate = DateValue("2-Nov-2014")
NumberOfDays = 1

For N = 0 To NumberOfDays - 1
Folder1 = UCase(Format(StartDate + N, "MMM YYYY"))
Folder2 = Format(StartDate + N, "DD MMM YYYY")
If Dir("C:\GRANDVARIATIONS\FILES\" & Folder1, vbDirectory) = "" Then
MkDir "C:\GRANDVARIATIONS\FILES\" & Folder1
End If
If Dir("C:\GRANDVARIATIONS\FILES\" & Folder1 & "\" & Folder2, vbDirectory) = "" Then
MkDir "C:\GRANDVARIATIONS\FILES\" & Folder1 & "\" & Folder2
End If




On Error Resume Next
Set oDoc = GetObject(sDocPath)
Set oWord = oDoc.Parent
If Err <> 0 Then
Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.Documents.Add
End If

oDoc.SaveAs ("C:\GRANDVARIATIONS\FILES\" & Folder1 & "\" & Folder2 & "\ANSWERS.Docx")
oDoc.Close

Next N
End Sub

В папке "FILES" уже есть «1-Nov-2014», и с помощью вышеуказанного кода я могу создать другой файл с именем «2-Nov-2014».

Но при создании файла с именем "3 ноября 2014 года" мне снова нужно изменить «StartDate = DateValue(" 2 ноября 2014 года ")» на «StartDate = DateValue(" 3 ноября 2014 года ")».

Есть ли способ, чтобы мне не приходилось менять это значение каждый раз, когда я хочу создать новый файл?

Answer 1

Sub Test()
Dim myDir As String
Dim Folder1 As String
Dim rRange1 As Range

Set rRange1 = Worksheets("Sheet1").Range("D3")

StartDate = Worksheets("Sheet1").Range("D3")
NumberOfDays = 1

For N = 0 To NumberOfDays - 1
    Folder1 = UCase(Format(StartDate, "MMM YYYY"))
    Folder2 = Format(StartDate + N, "DD MMM YYYY")
    If Dir("C:\GRANDVARIATIONS\FILES\" & Folder1, vbDirectory) = "" Then
        MkDir "C:\GRANDVARIATIONS\FILES\" & Folder1
    End If
    If Dir("C:\GRANDVARIATIONS\FILES\" & Folder1 & "\" & Folder2, vbDirectory) = "" Then
        MkDir "C:\GRANDVARIATIONS\FILES\" & Folder1 & "\" & Folder2
    End If




On Error Resume Next
    Set oDoc = GetObject(sDocPath)
    Set oWord = oDoc.Parent
    If Err <> 0 Then
        Set oWord = CreateObject("Word.Application")
        Set oDoc = oWord.Documents.Add
    End If

oDoc.SaveAs ("C:\GRANDVARIATIONS\FILES\" & Folder1 & "\" & Folder2 & "\ANSWERS.Docx")
oDoc.Close

Next N
End Sub

Answer 2

Предполагая, что вы хотите использовать сегодняшнюю дату для создания папок, измените

StartDate = DateValue("2-Nov-2014")

чтобы:

StartDate = DateValue(date)

Если вы хотите что-то еще, то, боюсь, ваш вопрос неясен и нуждается в большей ясности.