Page 1 of 2 12 LastLast
Results 1 to 15 of 16
  1. #1
    2 Star Lounger
    Join Date
    Jan 2007
    Location
    Gray, Louisiana, USA
    Posts
    289
    Thanks
    0
    Thanked 0 Times in 0 Posts
    This is a Macro that the lounge helped me with a while back. It works like a charm.

    I was wondering though if it could be edited to automatically create a folder, based on a cells content-Say A1

    I would keep the named folder here which is "infoforms", then I would like a prompt to ask for a "sub-folder name"(so I could edit if needed), show the name of the sub-folder, to be created under "infoforms" then the current worksheet would be saved in the new sub-folder.

    I hope this makes sense. I would like it to end up as C:/Infoforms/newsubfolder/filename

    Sub SaveFile()
    Dim sFName As String
    Range("A1:M1").Select
    Range("d2").Select
    ActiveCell.Value = Now()
    Range("e12").Select
    sFName = "C:\InfoForms\" & Range("e12") & (" ") & Range("e13") & Format(Date, "-mmddyyyy")
    MsgBox "File will be saved as " & sFName
    ActiveWorkbook.SaveAs (sFName)
    End Sub

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    You could use something like this:

    Code:
    Sub SaveFile()
      Dim sFName As String
      Dim sPath As String
      Range("D2").Value = Now()
      sPath = "C:\InfoForms\" & Range("A1") & "\"
      If Dir(sPath, vbDirectory) = "" Then
    	MkDir sPath
      End If
      sFName = sPath & Range("E12") & (" ") & Range("E13") & Format(Date, "-mmddyyyy")
      MsgBox "File will be saved as  " & sFName
      ActiveWorkbook.SaveAs sFName
    End Sub
    Dir(sPath, vbDirectory) will return a non-blank string if the folder exists, a blank string if it doesn't. So we use that to decide whether the folder should be created.

  3. #3
    2 Star Lounger
    Join Date
    Jan 2007
    Location
    Gray, Louisiana, USA
    Posts
    289
    Thanks
    0
    Thanked 0 Times in 0 Posts
    This is perfect.

    I was fooling around with MkDir but got no where, Thanks a million!

  4. #4
    2 Star Lounger
    Join Date
    Jan 2007
    Location
    Gray, Louisiana, USA
    Posts
    289
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Another question:

    I'm using 2007, but this worksheet is in 2003 and needs to stay in 2003 Format. To change the save file code t assure it is a 2003 workbook format would I edit it like this?

    From
    sFName = sPath & Range("F3") & (" ") & Range("F2") & Format(Date, "-mmddyyyy")
    To
    sFName = sPath & Range("F3") & (" ") & Range("F2") & Format(Date, "-mmddyyyy") & ".xls"

  5. #5
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    In addition to specifying .xls as extension, you must also specify the correct fileformat in the SaveAs instruction:

    ActiveWorkbook.SaveAs sFName, xlExcel8

    xlExcel8 specifies the Excel 97-2003 file format (8 is the internal version number of Excel 97; the file format for Excel 2000, 2002 and 2003 is the same as that for Excel 97).

  6. #6
    2 Star Lounger
    Join Date
    Jan 2007
    Location
    Gray, Louisiana, USA
    Posts
    289
    Thanks
    0
    Thanked 0 Times in 0 Posts
    My code stops on the last line, did I enter it wrong?

    Sub SaveFile()
    Dim sFName As String
    Dim sPath As String
    Sheets("Audit").Select
    Range("F1:F4").Select
    Selection.Copy
    Sheets("Punchlist").Select
    Range("E1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Audit").Select
    Range("F5:F8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Punchlist").Select
    Range("G1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Audit").Select
    Range("F1").Value = Now()
    sPath = "C:\MERITierll\" & Range("F2") & "\"
    If Dir(sPath, vbDirectory) = "" Then
    MkDir sPath
    End If
    sFName = sPath & Range("F3") & (" ") & Range("F2") & Format(Date, "-mmddyyyy")
    MsgBox "File will be saved as " & sFName
    ActiveWorkbook.SaveAs sFName, xlExcel8
    End Sub

  7. #7
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    You should specify the .xls extension:

    sFName = sPath & Range("F3") & " " & Range("F2") & Format(Date, "-mmddyyyy") & ".xls"

  8. #8
    2 Star Lounger
    Join Date
    Jan 2007
    Location
    Gray, Louisiana, USA
    Posts
    289
    Thanks
    0
    Thanked 0 Times in 0 Posts
    End If
    sFName = sPath & Range("F3") & " " & Range("F2") & Format(Date, "-mmddyyyy") & ".xls"
    MsgBox "File will be saved as " & sFName
    ActiveWorkbook.SaveAs sFName, xlExcel8 <--- It still stops here
    End Sub

  9. #9
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    What does the error message say?

  10. #10
    2 Star Lounger
    Join Date
    Jan 2007
    Location
    Gray, Louisiana, USA
    Posts
    289
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Well I think it was me mistyping information, or making the changes in VBA and trying the code with out saving first then starting from scratch.

    I just tried it again and it worked fine.

    thanks for your patience and your help

  11. #11
    2 Star Lounger
    Join Date
    Jan 2007
    Location
    Gray, Louisiana, USA
    Posts
    289
    Thanks
    0
    Thanked 0 Times in 0 Posts
    The Error was 1004

    It seems that if the indicated sFName cell references, F3 and F2, are left blank, or if a folder and filename already exists, I get this error.

    If a user gets this error, how could I let them know what they need too do to correct it?
    I'm thinking a message box, but where would I put it?

  12. #12
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    You could put code like this at the beginning of the macro:

    Code:
      If Range("F2") = "" Then
    	Range("F2").Select
    	MsgBox "Please enter a value in cell F2", vbExclamation
    	Exit Sub
      End If
      If Range("F3") = "" Then
    	Range("F3").Select
    	MsgBox "Please enter a value in cell F3", vbExclamation
    	Exit Sub
      End If

  13. #13
    2 Star Lounger
    Join Date
    Jan 2007
    Location
    Gray, Louisiana, USA
    Posts
    289
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Thankyou very much!

  14. #14
    2 Star Lounger
    Join Date
    Jan 2007
    Location
    Gray, Louisiana, USA
    Posts
    289
    Thanks
    0
    Thanked 0 Times in 0 Posts
    My code has one more error I would like to avoid. Upon saving the file using the macro, If the file already exists, you are givena message by default that asks if you want to save it anyway. If you choose yes, then all is ok, but if you choose no you get error 1004 and a choice to debug. Can this option be skipped - I could probably just put in a Replace somewhere after the code secifies to save the file, but where?

    Here's my code:

    Sub SaveFile()
    Dim sFName As String
    Dim sPath As String
    If Range("F2") = "" Then
    Range("F2").Select
    MsgBox "Please enter a value in cell F2", vbExclamation
    Exit Sub
    End If
    If Range("F3") = "" Then
    Range("F3").Select
    MsgBox "Please enter a value in cell F3", vbExclamation
    Exit Sub
    End If
    Sheets("Audit").Select
    Range("F1:F4").Select
    Selection.Copy
    Sheets("Punchlist").Select
    Range("E1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Audit").Select
    Range("F5:F8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Punchlist").Select
    Range("G1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("Audit").Select
    Range("F1").Value = Now()
    sPath = "C:\MERITierll\" & Range("F2") & "\"
    If Dir(sPath, vbDirectory) = "" Then
    MkDir sPath
    End If
    sFName = sPath & Range("F3") & (" ") & Range("F2") & Format(Date, "-mmddyyyy")
    MsgBox "File will be saved as " & sFName
    ActiveWorkbook.SaveAs sFName, xlExcel8
    End Sub

  15. #15
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    If you'd like the existing workbook to be overwritten without questions asked, you can use

    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs sFName, xlExcel8
    Application.DisplayAlerts = True

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •