Edit Data Connection - excel

First post, hello to everyone.
I am looking for code for a button when pressed will prompt the user to change the data connection source file. The following code works to the point of requesting the user to pick a new source file but none of the connections then update with the new filepath, any ideas? Thanks in advance
Sub xlTest()
Dim i As Long
Dim cnt As Long
Dim cn
cnt = ActiveWorkbook.Connections.Count
'Choose a File
strPath = Application.GetOpenFilename(Title:="Choose a file", _
FileFilter:="Excel Files *.xls* (*.xls*),")
If strPath = False Then
MsgBox "No file selected. Exiting now.", vbExclamation
Exit Sub
End If
'Change Connection source filepath for each connection
For i = cnt To 1 Step -1
Set cn = ActiveWorkbook.Connections.Item(i)
cn.OLEDBConnection.SourceDataFile = strPath
Next i
End Sub

I don't understand why are you using the For Next statement, since it looks like you're opening only one file per execution. But I think you can replace the code inside it for ActiveWorkbook.Connections.AddFromFile (strPath), it will prompt you to a dialog to choose a sheet inside to connect, also you don't need to declare your 'cn' variable.

Related

Create live copy of password protected excel workbook

I have a workbook that is password protected and I’d like to create a read only copy that other users can view on a different location on the network drive.
I know it’s a strange request as the other people could open the original as read only, but we don’t want them to know the location of the original or have anything to do with it, should they figure out my colleagues password.
The other issue we had was that people were opening as read only and it was still telling my colleague that it was locked by another user and he needs it for most of the day so that issue is annoying
Thanks in advance
What you could do is add the following event procedure to the ThisWorkbook module:
Const RemotePath As String = "D:\YourRemoteLocation\"
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
On Error GoTo CleanUp
If Success And InStr(ThisWorkbook.Name, "Copy of ") = 0 Then
Dim CopyFullName As String
CopyFullName = RemotePath & "Copy of " & ThisWorkbook.Name
Application.EnableEvents = False
Dim fso As FileSystemObject 'Requires the Microsoft Scripting Runtime Library
Set fso = New FileSystemObject
fso.CopyFile Source:=ThisWorkbook.FullName, Destination:=CopyFullName
Dim ReadOnlyWorkbook As Workbook
Set ReadOnlyWorkbook = Workbooks.Open(Filename:=CopyFullName)
Application.DisplayAlerts = False
ReadOnlyWorkbook.SaveAs Filename:=CopyFullName, Password:=""
Application.DisplayAlerts = True
ReadOnlyWorkbook.Close SaveChanges:=False
End If
CleanUp:
Application.EnableEvents = True
Application.DisplayAlerts = True
Set fso = Nothing
End Sub
This code will run every time the workbook is saved and export the current file to the remote location. Then it will open the copy and save it as a workbook without password.
Note that I've added InStr(ThisWorkbook.Name, "Copy of ") = 0 as a condition to the If-statement. Instr returns the position where a substring (arg2) appears in the main string (arg1) or zero if the substring is absent from the main string. In this context, we want it to be zero since we don't want to run the code in the workbook copy.
In this method, the owner of the original file will have to supply their password every time they save. You could automate this by passing the password as an argument to the Open method like this:
Set ReadOnlyWorkbook = Workbooks.Open( _
Filename:=CopyFullName, _
Password:="MyPassword")
However, the password would then be accessible by people looking into the VBA code.
Alternatively you could get the password from a local file that wouldn't be accessible from the Network, but then the file path would be visible.
And if the remote folder is not already set to be Read-only mode, you can make sure that people opening the remote version of the file do so in Read-Only mode by adding the following event procedure after the previous one.
Private Sub Workbook_Open()
If InStr(ThisWorkbook.Name, "Copy of ") = 0 Then
ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
End If
End Sub
Obviously this will only work if they enable macros.

Visual basic application written for Jira and Excel file error message

we have an Importer for Jira that imports projects and configures them. I did not write the code myself and there is absolutely no technical documentation regarding it.
A few days ago its started showing an error message
I checked the directory and the file permissions and everything but it is still not working. The other thing is that it is not working solely for one person. Does anyone have any ideas?
Public Sub getValuesFromFile()
' if the property excelDefaultValues has already values in it break this sub
If excelDefaultValues.Count > 0 Then
Exit Sub
End If
' Definitions
Dim ExcelFolder As String
Dim selectedfile As String
Dim excel As Application
Dim workbook As Workbook
Dim sheet As Worksheet
Dim column As Integer = 0
Dim row As Integer = 0
' Define the location and name of the default values file
ExcelFolder = "R:\PM\01_Team\01_Allgemein\07_Jira_Importer\Masterfile"
selectedfile = ExcelFolder & "\" & "DefaultValues.xlsx"
' try to open excel and the file
Try
excel = New Application
excel.DisplayAlerts = False
excel.Workbooks.Open(selectedfile)
workbook = excel.ActiveWorkbook
sheet = workbook.Worksheets(1)
' fails if the file does not exist, open a message box.
Catch
MsgBox("file template not found! please make sure that the file is in this directory:" & vbCrLf & selectedfile, MsgBoxStyle.OkOnly, "warning!")
Exit Sub
End Try

Check folder & compare for an exact list of txt files. Also have a public variable with folderpicker that I can't get to display inside a msgbox

I have a activex button trying to get it to check folder for a specific set of .txt files. I would like to compare all files names against a list of files names to see what is not listed inside the folder. Also within this check for files module is a publicvariable call to list the folder path (that the user picked with folderpicker) but haven't got it to work. This same publicvariable should be in the next line down in the Msgbox listing the folder path that was selected. I can place a list of files anywhere in the workbook. Currently, I have working a check file module that returns a message whether or not file exist.
I was just able to get my public variable to work. This is not what i do so learning by reading and learning how to asks questions. By moving lines /words around I have been able to get a few things working. Although, I sure it is not the most efficient way.
'Working but only checks one file at a time. and hard coded
Sub CheckFolderForFiles()
'
' CheckFolderForFiles Macro
'
'Check if file exist
If Dir$("C:\txtdata\cf_preferences.txt") = "" Then
MsgBox "C:\txtdata\cf_preferences.txt - File not found"
Exit Sub
End If
____________________________________
' Not working - Just testing public variable call for Dir$ and figure out MsgBox areas.
Sub CheckFolderForFiles()
'
' CheckFolderForFiles Macro
'
'Check if file exist
If Dir$(Module33.fle + "\alerts.txt") = "" Then
MsgBox & fle & "alerts.txt - File not found"
Exit Sub
End If
'
'
End Sub
__________________________________
'Folder Picker FileDialog user select folder.
'After some guidence by one our your users I was able to get this module work.
'Now have a public variable I wish to use throughtout the workbook to
'call the path.
Public fle As String
Sub FolderPicker()
Dim diaFolder As FileDialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Show
fle = diaFolder.SelectedItems(1)
Range("M11") = fle
Set diaFolder = Nothing
End Sub
-------------------------------
Sub CheckFolderForFiles()
'
' CheckFolderForFiles Macro
'
'Check if file exist
'
'
If Dir$(Module33.fle + "\alerts.txt") = "" Then
MsgBox Module33.fle + "\alerts.txt - File not found"
End If
'
If Dir$(Module33.fle + "\cf_messages.txt") = "" Then
MsgBox Module33.fle + "\cf_messages.txt - File not found"
End If
End Sub
----------------------------
I'm trying to learn this to help with my wife's work project. so please be patient with my descriptions and lack of terminology. But if someone could guide me to a script that compares files within a folder that came from the publicvariable and tell me all files missing from the list. (15 files in all) this would help a bunch. Also, anyone know how or if you can clear a publicvariable of it's stored data? googling is saying just put an ( End ) in the module. not working.
Thank You in Advance. I do appreciate the guidance.
Try this. I use ArrayList to filter out nonexisting files. If you want to print out a list of non existing files, just print out the remaining element of the arraylist FileList, you could google the syntax.
Sub TestFileExist()
Dim fd As FileDialog
Dim mFiles As Variant, Item As Variant
Dim FileList As Object, mRange As Range, strFile As String
Dim FilesInFolder() As String
Dim i As Long
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Select a folder"
.AllowMultiSelect = False
End With
If fd.Show = -1 Then
Set FileList = CreateObject("System.Collections.ArrayList")
Set mRange = Range("A1:A5") 'Range contains files' names
ReDim FilesInFolder(0) As String
strFile = Dir(fd.SelectedItems(1) & "\*.txt")
Do While Len(strFile) > 0
FilesInFolder(UBound(FilesInFolder)) = strFile
strFile = Dir
ReDim Preserve FilesInFolder(UBound(FilesInFolder) + 1) As String
Loop
For Each Item In mRange
If Not FileList.contains(Item.Value) Then
FileList.Add Item.Value
End If
Next Item
For i = 0 To UBound(FilesInFolder) - 1
If FileList.contains(FilesInFolder(i)) Then
FileList.Remove FilesInFolder(i)
End If
Next i
MsgBox FileList.Count 'Nbr of files not found
End If
End Sub

VBA code executes but only if I step thru it

I used some code from Close an opened PDF after opening it using FollowHyperlink to create the following code to open a pdf file and rename it. The code runs fine but only if I break execution at MsgBox "Break Here" and step into it with the F8 key. Any ideas on why it won't execute automatically?
Sub OpenPDF()
'Opens PDF Scaned file & saves it to another folder
'***ErrorHandler***
On Error Resume Next
'***Declare Objects****
Dim objectWMI As Object
Dim objectProcess As Object
Dim objectProcesses As Object
Dim Path As String
Dim MyDir As String
'***Opens a new workbook if there are no active workbooks***
'***There must be an active workbook for FollowHyperlink to function***
nowbs = Application.Workbooks.Count
If nowbs = 1 Then
Application.Workbooks.Add
Else
End If
'***Saves current Excel path
MyDir = CurDir
'***Sets path to Ricoh Scans
PDFDir = "S:\Ricoh Scans"
ChDir PDFDir
'***Gets filename for PDF scan
Path = Application.GetOpenFilename(filefilter:="PDF file (*.pdf), *.pdf")
'***Opens PDF file***
ActiveWorkbook.FollowHyperlink Path
'***Sets Excel as active application
AppActivate "Microsoft Excel"
'***Prompts for PO number****
MyPONum = InputBox("Enter PO Number", "PO Editor", "30500")
'***If user selects Cancel on inputbox then xl closes Acrobat and exits sub
If MyPONum = vbNullString Then
GoTo EndAll
Else
End If
'***Replaces scanned filename with inputbox filename
PathLen = Len(Path)
OldName = Mid(Path, 16, PathLen - 19)
NewName = "S:\Materials Management\Purchase Orders\PO " & MyPONum & ".pdf"
EndAll:
'***Set Objects***
Set objectWMI = GetObject("winmgmts://.")
Set objectProcesses = objectWMI.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'Acrobat.exe'") '< Change if you need be ** Was AcroRd32.exe**
'
'
'Code executes fine up to here but must Ctrl + Break at this line
'and F8 step thru balance of code or it will not work
'
'
MsgBox "Break Here"
'***Terminate all Open PDFs***
For Each objectProcess In objectProcesses
Call objectProcess.Terminate
Next
'***Clean Up***
Set objectProcesses = Nothing
Set objectWMI = Nothing
'***Renames scanned file and moves it to Materials Management folder***
Name Path As NewName
'***Resets current directory
ChDir MyDir
End Sub
Thanks to all for your input. I'm not a programmer and as I said I used code that had been posted elsewhere on this site. It was a timing issue and this edit works.
'***Terminate all Open PDFs***
For Each objectProcess In objectProcesses
objectProcess.Terminate
Next
'***Clean Up***
Set objectProcesses = Nothing
Set objectWMI = Nothing
'***************
Application.Wait (Now + TimeValue("00:00:02"))
'***Renames scanned file and moves it to Materials Management folder***
Name Path As NewName
'***Resets current directory
ChDir MyDir
End Sub

how to check a file is existing or not in VB based on filename that pick from date

I want to create a macro that can check and open file based on filename.
ex:
15.xlsm As opened workbook
12.xlsm As a target
16.xlsm As the future workbook
So while I click a button in 15.xlsm that will open the previous file (12.xlsm). But in future, when the 16.xlsm is created, the 16.xlsm must open the previous workbook (15.xlsm).
I was trying with this code
Sub Macro1()
Dim a, x As Integer
Dim path, filename As String
Dim varday, varyest As Long
varday = Day(Range("A1"))
For x = 1 To 30
varyest = varday - x
filename = "" & varyest & ".xlsm"
path = "F:\Kemal\" & filename & ""
If Dir(path) = "" Then
Else
Workbooks.Open filename:=path
End If
Next x
End Sub
but that code has open all workbook like 12.xlsm, 10.xlsm, 9.xlsm, and create unlimited messagebox. Yeah I know the algorithm but, how to put it into code is the big problem. anyone help me, pls.
So, How to check previous file is exist or not with date that placed on every workbook name?
to know if file exists :
CreateObject("Scripting.FileSystemObject").FileExists(p)
If you want to check MANY files, you may want to use the content of the whole folder and lookup the array.
if target workbooks has a Workbook_Open that's not to be launched:
Application.EnableEvents = False
workbooks.open(file)
Application.EnableEvents = true
Question is a bit fuzzy to me, I hope this answers

Resources