Link to home
Create AccountLog in
Avatar of agbnielsen
agbnielsen

asked on

Need a custom macro for Excel 2010

Hi All,

I need to program a macro into a Excel 2010 ribbon button for a few users.

Simply all I need to do is take the current file name that is open in Excel (spreadsheet.xlsm) and save it to C:\Daily Insight Reports.

Please see the attached image for the logic that I would like the button to follow.

Please feel free to ask for anything that may require clarification.

Cheers

User generated image
Avatar of RobSampson
RobSampson
Flag of Australia image

Hi there,

This should work for testing as a template (xltm):
Sub SaveAsJPG()
    If InStr(ActiveWorkbook.Name, ".") > 0 Then
        strWorkbookName = ActiveWorkbook.Name
        strSaveFolder = "C:\Daily Insight Report Files\"
        If Right(strSaveFolder, 1) = "\" Then strSaveFolder = Left(strSaveFolder, Len(strSaveFolder) - 1)
        If Dir(strSaveFolder, vbDirectory) = "" Then MkDir strSaveFolder
        blnContinue = False
        If Dir(strSaveFolder & "\" & strWorkbookName) <> "" Then
            intResponse = MsgBox(strWorkbookName & " already exists. Do you want to overwrite?", vbYesNo, "Overwrite?")
            If intResponse = vbYes Then
                blnContinue = True
                Kill strSaveFolder & "\" & strWorkbookName
            End If
        Else
            blnContinue = True
        End If
        If blnContinue = True Then
            ActiveWorkbook.SaveAs strSaveFolder & "\" & strWorkbookName, xlNormal
            MsgBox strWorkbookName & " has been created in " & strSaveFolder
        Else
            MsgBox "File has not been overwritten."
        End If
    Else
        MsgBox "The workbook has not been saved.  Please save it to use this feature."
    End If
End Sub

Open in new window


but if you want to put it into an add in, so you can use it from a custom tab on the ribbon, change this line:
Sub SaveAsJPG()

Open in new window


to this:
Sub SaveAsJPG(ByVal control As IRibbonControl)

Open in new window


Regards,

Rob.
Oh, the macro doesn't need to be called SaveAsJPG....probably better of as ArchiveFileToFolder or something...
Avatar of agbnielsen
agbnielsen

ASKER

Yep good one Rob, thanks.

One thing though, I cannot overwrite an existing file. It prompts me for overwrite, but when I click yes it errors:

Run-time error '70':

Permission denied.

Now I have checked the security on that directory and there is nothing preventing this. If I overwrite the file through Excel manually (File -> Save As) it works no problems.

When I click debug, it is telling me there is a problem with the following line:


Kill strSaveFolder & "\" & strWorkbookName

Open in new window

I think you must be running a macro from a file that is already in that folder.  This means you can't delete (Kill) the file that is currently open.

I'll just make a quick change....it won't need to use Kill....we can just overwrite...
Try this.  A bit cleaner.

Rob.
Sub ArchiveFile()
    If InStr(ActiveWorkbook.Name, ".") > 0 Then
        strWorkbookName = ActiveWorkbook.Name
        strSaveFolder = "C:\Daily Insight Report Files\"
        If Right(strSaveFolder, 1) = "\" Then strSaveFolder = Left(strSaveFolder, Len(strSaveFolder) - 1)
        If Dir(strSaveFolder, vbDirectory) = "" Then MkDir strSaveFolder
        If Dir(strSaveFolder & "\" & strWorkbookName) <> "" Then
            intResponse = MsgBox(strWorkbookName & " already exists. Do you want to overwrite?", vbYesNo, "Overwrite?")
            If intResponse = vbYes Then
                Application.DisplayAlerts = False
                ActiveWorkbook.SaveAs strSaveFolder & "\" & strWorkbookName, xlNormal
                Application.DisplayAlerts = True
            Else
                MsgBox "File has not been overwritten."
            End If
        Else
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs strSaveFolder & "\" & strWorkbookName, xlNormal
            Application.DisplayAlerts = True
            MsgBox strWorkbookName & " has been created in " & strSaveFolder
        End If
    Else
        MsgBox "The workbook has not been saved.  Please save it to use this feature."
    End If
End Sub

Open in new window

Yep great, almost there! Just one final bit of logic, when the file is overwritten, can we advise the user that the file has been overwritten??
Wrong number of arguments (Error 450) 

The number of arguments to a procedure must match the number of parameters in the procedure's definition. This error has the following causes and solutions:


The number of arguments in the call to the procedure wasn't the same as the number of required arguments expected by the procedure. 
Check the argument list in the call against the procedure declaration or definition.

You specified an index for a control that isn't part of a control array.
The index specification is interpreted as an argument but neither an index nor an argument is expected, so the error occurs. Remove the index specification, or follow the procedure for creating a control array. Set the Index property to a nonzero value in the control's property sheet or property window at design time.

You tried to assign a value to a read-only property, or you tried to assign a value to a property for which no Property Let procedure exists. 
Assigning a value to a property is the same as passing the value as an argument to the object's Property Let procedure. Properly define the Property Let procedure; it must have one more argument than the corresponding Property Get procedure. If the property is meant to be read-only, you can't assign a value to it.

Open in new window

Disregard that bit of code...
ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Legend!