Close workbook in excel with name changing weekly - vba

I have a file with the below macro. And basically I need it to close all the workbooks that opens however one of my files name changes everyweek so for example, for this week it is called Special Services 1503,next week it will be Special Services 1504 etc. Any idea on how to edit the below code so that I can close this file without manually editing the number in vba?
Workbooks("2014 Actuals").Close SaveChanges = True
Workbooks("Special Services Budget 2015").Close SaveChanges = True
The above work because no editing, the below works but I manually have to change week number from 1504 to 1505 etc every week.
Workbooks("Special Services 1504").Close SaveChanges = True
Any ideas guys?

If I understood the logic, you only need to build a dynamic index:
firstWeek2015 = 1500 '<-- starting seed
yearFactor = Year(Now()) - 2015 '<-- we take the current year and we subtract 2015: this year it will be 0, next year 1 etc.
weekFactor = WorksheetFunction.WeekNum(Now()) '<--we just take the current week
newIndex = firstWeek2015 + yearFactor*52 + weekFactor
and replace it into your workbook name:
Workbooks("Special Services " & newIndex).Close SaveChanges = True
Even if I would rather:
1) Use the same logic that you used to open the file;
2) Use a RegEx-based solution (if "Special Services ????" is the only file of that kind).

I'm adding this as a separate answer because it's a completely different approach from the previous one:
If and only if you are sure that only that workbook has a name which looks like Special Services 1054, then you can use the Like operator like this :
For Each objWb In Workbooks
If objWb.Name Like "Special Services *"
objWb.Close SaveChanges = True
End If
Next objWb
As stated in my previous answer, this approach is more reliable than the other one but only if you are 100% sure that there might not be another workbook with a similar name opened.

Related

Can I use VBA in Access to determine if a user has multiple instances of a database open?

I am looking for a way to determine if a user current has multiple instances of an Access database open on their machine. The purpose of this check would be to ensure better session handling.
It is perfectly fine for a user to open multiple instances. There are some elements of our work where this is a necessity, to browse existing records while entering a new one.
I came across this old forum post where a function is given to output a list of the currently open databases in the Workspace. I thought I may be able to adapt this to determine if the same database is open more than once on their machine. However, in testing the function (removing the part that opens a separate database), it always outputs the name of our database twice, regardless of whether I have just one instance open, or two or three.
Here's the adapted code I am using:
Public Sub listDBs()
Dim wrkCurrentWorkSpace As Workspace
Dim i As Integer
Dim strDatabases As String
Set wrkCurrentWorkSpace = DBEngine.Workspaces(0)
For i = 0 To wrkCurrentWorkSpace.Databases.Count - 1
If (i = 0) Then
strDatabases = wrkCurrentWorkSpace.Databases(i).Name
Else
strDatabases = strDatabases & Chr$(13) & Chr$(10) & wrkCurrentWorkSpace.Databases(i).Name
End If
Next
MsgBox strDatabases
Set wrkCurrentWorkSpace = Nothing
End Sub
Am I doing something wrong here?

Print XPS from Google Search without dialog with file name listed in excel file

I have an Excel file with three column A, B, C; Serial #, File #, Name.
I want to search column A on Google, and print the first page result in XPS format with set directory and File name containing something like this:
"Serial # / File # / Name"
"1 / 1103 / Mock up Name A. xps"
From various search online, I managed to cut and paste the following code:
Const OLECMDID_PRINT = 6
Const OLECMDEXECOPT_DONTPROMPTUSER = 1
Const PRINT_WAITFORCOMPLETION = 2
Sub AutoSearch()
Dim N As Long, i As Long
N = Cells(Rows.Count, "C").End(xlUp).Row
Dim objIE
Set objIE = CreateObject("InternetExplorer.Application")
With ActiveWorkbook
For i = 2 To N
objIE.Navigate "http://www.Google.com/search?q=" & Cells(i, 1).Value
objIE.Visible = 1
Do While objIE.ReadyState <> 4
DoEvents
Loop
objIE.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, 1
Next i
End With
End Sub
Above code allows me to grab column A name, search in Google, and print in XPS, but I still have no idea how to suppress the printing dialog, or manipulate it to save into the file name format and directory I want.
Being extreme unfamiliar with coding, all the solution for suppressing print dialog that I can find involving with something else other than VBA, but I have no idea how to translate that into vba.
(https://blogs.msdn.microsoft.com/fyuan/2007/02/24/printing-documents-to-microsoft-xps-document-writer-without-user-interaction/)
If you have any solution or better idea, please let me know.
Thank you so much
After "some" research and digging around, I found a walk around solution. Since I am not a programmer at all, I came across a freeware called, "http://www.weenysoft.com/free-html-to-pdf-converter.html", which is derived from "http://wkhtmltopdf.org/". For those super coder, the latter approach is better way, since you can tackle the solution more directly and efficiently; however, as for me, I had to stick with the first solution, which cannot give you time stamp on the pdf files it produces.
Thus, I need to use another walk around approach, "File_Name_Stamper.pdf (just google this)", to put the time stamp on my pdf files. To use on multiple files, you just need to use any Macro Recorder.
Again, totally not recommended for any programmers, above approaches are pretty sad, but does the job for the time being.
Cheers.

External file properties not updated - VBA

I have a macro that reads out external file properties like date created. The file from where I read is stored on a server. Unfortunately the date returned is not the correct one when running the macro the first time. Only when I open the file or when I run the macro several times, the correct updated date created is returned.
Does anyone have an idea how to solve that issue except from opening the file or looping through until the date is correct?
Here is the code:
strFilename = "<FILENAME>"
Workbooks.Open strFilename
Workbooks("strFilename").Close
Set oFS = CreateObject("Scripting.FileSystemObject")
lastcreatedLTVfile = CDate(Format(oFS.GetFile(strFilename).DateCreated, "dd.mm.yyyy"))
Do you want DateCreated or do you actually want DateLastModified? In your question you say "correct updated date" so I guess you should be using DateLastModified.

SPSS Script from version 15 to version 20 in BASIC

The below script is written in 'Winwrap basic' which is almost identical to VBA.
I would like this script to work on SPSS 20, the script works fine on SPSS15 (by changing the file extension from STT to TLO as that is what the tablelook file was back then).
However, whenever I run this script in SPSS 20 the wwb processor crashes with a generic error message 'WWBProcessor has encountered a problem and needs to close. We are sorry for the inconvenience.'
The script is well commented, but the purpose of the script is to change the tablelook of every table in the output viewer window, by activating each table in turn and setting the table look to one specified by the user, rotating the inner column labels, closing the table and activating the next table.
The loop continues until every table has been set to the new tablelook and rotation.
Manually setting the rotation of a few hundred tables is arduous and very time consuming not to mention numbingly boring. This script used to perform this task in seconds back in version 15, but ever evolving needs and lack of support for the older version has meant that I've been forced to use the newer version.
I'd be grateful for any assistance.
Mav
Option Explicit
Sub Main
'BEGIN DESCRIPTION
'This script changes all tabs to the same 'Tablelook' style. You will be prompted to choose the tablelook file.
'END DESCRIPTION
'******************
'Old description
'This script assumes that objSpssApp ist the currently running
'SPSS-Application and assigns every existing Pivot Table
'in the Output Navigator a new TableLook which can be selected
'from a Dialog box. Hidden tables will also be affected.
'Originally Created by SPSS Germany. Author: Arnd Winter.
'******************
'This script is written in the BASIC revision 'WinWrap Basic' code copied from VB or other basic languages may have to be modified to function properly.
On Error GoTo Bye
' Variable Declaration
' For an undertermined reason scripts cannot be executed throught the Utilites -> Run scripts menu,
' Instead they must be opened like a syntax file and ran from the SPSS 19 Scripting page.
' Functionality on SPSS 20 is now completely gone, error message only reads 'WWB processor has encountered a problem and needs to close'.
Dim objOutputDoc As ISpssOutputDoc 'Declares the Output variable
Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc 'Assigns currently active output to Output variable
Dim strAppPath As String
Dim objOutputItems As ISpssItems 'variable defining every item in the current output window
Dim objOutputItem As ISpssItem 'variable defining the current item
Dim objPivotTable As PivotTable
Dim intCount As Integer 'declare the variable that will store the number of instances
Dim varStrLook As String
Set objOutputItems=objOutputDoc.Items
Dim i As Integer 'for loops we need an INT variable that will be counted against the number of instances 'i' is standard notation
' Find out SPSS Directory
strAppPath = objSpssApp.GetSPSSPath
' Select TableLook
'The Parametres you must enter into the GetFilePath() function are as follows:
'(Optional)Firstly you enter the initial file name (if none is required use an asterisk * and the file extention, or *.*)
'(Optional)The second part is the file extention expected, you can choose multiple filetypes if you seperate them with a semi-colon ;
'(Optional)The third parametre is the directory where the file should be opened.(default - Current path)
'The fourth parametre is the Title of the prompt, which should be enclosed in speech marks.
'The Final parametre is the 'Option'
'0 Only allow the user to select a file that exists.
'1 Confirm creation when the user selects a file that does not exist.
'2 Allow the user to select any file whether it exists or not.
'3 Confirm overwrite when the user selects a file that exists.
'+4 Selecting a different directory changes the application's current directory.
'For more detailed information visit the WWB website.
' http://www.winwrap.com/web/basic/language/?p=doc_getfilepath__func.htm
varStrLook = GetFilePath$("*.stt","stt",strAppPath,"Select Tablelook and confirm with Save.",4)
' Tested re-applying the dollar sign, cofusingly removing or adding the Dollar sign ($)
' seems to have no effect.
' If user presses Cancel or selected a file with the wrong file type then exit script
If (Len(varStrLook)= 0) Or (Right(varStrLook,3)<>"stt") Then
Exit Sub
End If
' Loop which assigns a new TableLook to all existing Tables.
intCount = objOutputItems.Count 'Assigns the total number of output items to the count-marker
For i = 0 To intCount-1 'Start loop
Set objOutputItem=objOutputItems.GetItem(i) 'Get current item
If objOutputItem.SPSSType=SPSSPivot Then 'If the item is a pivot table then...
Set objPivotTable=objOutputItem.ActivateTable 'Activate the table for editing
objPivotTable.TableLook = varStrLook 'Apply the earlier selected table look.
objPivotTable.RotateColumnLabels=True 'Rotate collumn lables
objOutputItem.Deactivate 'Confirm changes and deactivate the table
End If
Next 'End loop
'********************************************************
'Updated script from Version 15 ->
'Script now includes inner column label rotation
'Script has been modified and adapted to improve performance
'and to help people who wish to use/adapt the script
'in future endeavours.
'********************************************************
Bye:
End Sub
The first thing to try is to replace the activate/deactivate calls with
GetTableOLEObject
This is much more efficient and does not require the pivot table editor, but you can do all the things that you could do on an activated table.
If you don't have the current fixpack for V20, fixpack2, installing that would be a good idea, too.

VBA File Dialog .FileName removing .1 from end of file name

I am using visual basic to write a Macro for Autodesk Inventor. I created a macro that calls a file dialog, see code below. Everything works fine except when a user puts a file name in with a period and a number greater than zero following it.
For example, if a user puts testfile.test in the box and hits ok. When I ask for what they put in there using .FileName, I get "testfile.test". Just like I should.
However, if the user puts testfile.1 or testfile.10 or testfile.1mdksj or anything as long as a number greater than zero directly follows the period I get back "testfile". For some reason, everything after the period and the period gets removed.
What is the reason for this? Is this a bug in visual basic or am I doing something wrong?
'Set up the file dialog
Dim oFileDlg As FileDialog
' Create a new FileDialog object.
Call ThisApplication.CreateFileDialog(oFileDlg)
'Define the filter to select part and assembly files or any file.
oFileDlg.Filter = "All Files (*.*)|*.*"
'Define the part and assembly files filter to be the default filter.
oFileDlg.FilterIndex = 1
'Set the title for the dialog.
oFileDlg.DialogTitle = "Save File As"
'Tell the dialog box to throw up and error when cancel is hit by user
oFileDlg.CancelError = True
'Show the file dialog
On Error Resume Next
oFileDlg.ShowSave
'save the user specified file
Dim newFileName As String
newFileName = oFileDlg.FileName
UPDATE:
I ended up doing the following "hack" to make things still work while dealing with a period:
oFileDlg.fileName = sFname & "."
oFileDlg.ShowSave
fullName = Left$(oFileDlg.fileName, Len(oFileDlg.fileName) - 1)
That worked fine for quite a while on Windows 7 and then Windows 10. Unfortunately, the Windows 10 Creative update seems to have changed how the file dialog works. With the above code, fullName would come back blank if there were no periods in the name and would truncate everything from the FIRST period from the left if there was a period in the name.
I'm not really sure what changed in Windows 10, but it pretty much destroyed my hack. Windows 7 still works fine and Windows 10 before the creative update works. I ended up doing the following to make everything work again in the version of Windows I mentioned above.
oFileDlg.fileName = sFname & ".00"
oFileDlg.ShowSave
fullName = Left$(oFileDlg.fileName, Len(oFileDlg.fileName) - 3)
This is a VB property, but it may extend to VBA as well. Have you tried setting the save settings to support multidotted extensions? Try something like this:
SupportMultiDottedExtensions = True
This setting is intended permit the use dotted extensions - meaning the use of periods in the file name. See this MSDN reference for documentation and information: http://msdn.microsoft.com/en-us/library/system.windows.forms.filedialog.supportmultidottedextensions.aspx#Y129
This SO article may also shed further light: SaveAs Dialog with a period in the filename does not return extension
EDIT
After checking the autodesk documentation - a difficult and unpleasant task, in my opinion - there does indeed appear to be no support for MultidottedExtensions. I did, however, find a function on VBAExpress that I have very closely adapted. The function can be used to filter strings with contain unacceptable characters. Jimmy Pena's blog has an excellent function for just such a purpose: http://www.jpsoftwaretech.com/excel-vba/validate-filenames/. I have only substantively added a period and a replace to the code:
'A function for filtering strings, with a focus on filenames.
Function FilterFileNameString(stringToScrub As String) As String
'Filters a filename string - or any string for that matter.
Dim FilteredString As String
'A highly nested replace function.
FilteredString = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(stringToScrub, ".","|", ""), ">", ""), "<", ""), Chr(34), ""), "?", ""), "*", ""), ":", ""), "/", ""), "\", "")
'Returns filtered string.
FilterFileNameString = FilteredString
End Function
Jimmy Pena's blog also contains a recursive version as well, although he does not recommend it.
You can filter any strings to be used as filenames with another character - a space in this case. You could use an underscore, however, or any other character you deemed pleasant.
In general, if you are trying to use periods for versioning or a similar purpose, and inventor will not let you, I would strongly advise going to another character or set of characters that can provide such an indication, such an underscore "_", a numbering system, "001", "002", a lettering system, "AAA", "AAB", or whatever makes sense for your focus.
If you are just making the application user-friendly, I would suggest filtering the strings entered before saving them in the desired filetype, and separate the filtering of the strings from the save dialog if the period filtering gives you grief. It may add an extra step, but it may be the best and easiest way to filter out pesky invalid characters without creating unnecessary extra hassles for your users.
~JOL