Solved: Need help in importing pictures and saving as pdf file on specific location.

[Kumarcoolz]

Hi Guys, i am a novice at VBA coding but i managed to manipulate a recorded macro to my need. the code is as below:

The code works fine but not to my needs. my intension is to save the pdf file in the same location as the folder from where the pictures are taken

i have got the file location at the begining of the code as "StrPath = .SelectedItems(1)"
but i am unable to seperate the path as i desired, i tried to directly use excel formula, only to find out VBA doesnt work that way :wot .

Eg:
if "StrPath = .SelectedItems(1)" fetchs the path as "C:\Documents and Settings\QI_3618\Desktop\kumar.jpeg"
then StrNewPath shall become "C:\Documents and Settings\QI_3618"
and strDocName shall become "Desktop"

I have attached the excel sheet which does the above function. 9973. i used the formula below in the VBA Code and it resulted in lot of function errors

StrPath = SUBSTITUTE(Left("StrPath", Find(Char(1), SUBSTITUTE("StrPath", "\", Char(1), Len("StrPath") - Len(SUBSTITUTE("StrPath", "\", "")) - 1))), "\", "", Len("StrPath") - Len(SUBSTITUTE("StrPath", "\", "")) - 1)
strDocName = SUBSTITUTE(Left(Right("StrPath", Len("StrPath") - Len(Left("StrPath", Find(Char(1), SUBSTITUTE("StrPath", "\", Char(1), Len("StrPath") - Len(SUBSTITUTE("StrPath", "\", "")) - 1))))), _
Find(Char(1), SUBSTITUTE(Right("StrPath", Len("StrPath") - Len(Left("StrPath", Find(Char(1), SUBSTITUTE("StrPath", "\", Char(1), Len("StrPath") - Len(SUBSTITUTE("StrPath", "\", "")) - 1))))), "\", Char(1), _
Len(Right("StrPath", Len("StrPath") - Len(Left("StrPath", Find(Char(1), SUBSTITUTE("StrPath", "\", Char(1), Len("StrPath") - Len(SUBSTITUTE("StrPath", "\", "")) - 1)))))) - Len(SUBSTITUTE(Right("StrPath", Len("StrPath") - Len(Left("StrPath", Find(Char(1), _
SUBSTITUTE("StrPath", "\", Char(1), Len("StrPath") - Len(SUBSTITUTE("StrPath", "\", "")) - 1))))), "\", ""))))), "\", "", Len(Right("StrPath", Len("StrPath") - Len(Left("StrPath", Find(Char(1), SUBSTITUTE("StrPath", "\", Char(1), _
Len("StrPath") - Len(SUBSTITUTE("StrPath", "\", "")) - 1)))))) - Len(SUBSTITUTE(Right("StrPath", Len("StrPath") - Len(Left("StrPath", Find(Char(1), SUBSTITUTE("StrPath", "\", Char(1), Len("StrPath") - Len(SUBSTITUTE("StrPath", "\", "")) - 1))))), "\", "")))
:doh: :doh:

Kindly help me with this or suggest better approach. I Hope i have conveyed my intend in the right way


Sub InsertImages()
Dim doc As Word.Document
Dim bkmName As String
Dim SigFile As String
Dim fd As FileDialog
Dim mg2 As Range
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Set doc = ActiveDocument
Dim vrtSelectedItem As Variant
Dim theText() As String
Dim theText2 As String
Dim Char As Characters
Dim StrPath As String
Dim StrNewPath As String
Dim strDocName As String




With fd
.Filters.Add "Images", "*.jpg", 1

.FilterIndex = 1

If .Show = -1 Then
StrPath = .SelectedItems(1)
For Each vrtSelectedItem In .SelectedItems

Set mg2 = ActiveDocument.Range
mg2.Collapse wdCollapseEnd

doc.InlineShapes.AddPicture _
FileName:=vrtSelectedItem, _
LinkToFile:=False, SaveWithDocument:=True, Range:=mg2

Next vrtSelectedItem
Else

MsgBox ("No Images Selected")
Exit Sub
End If

End With

Set fd = Nothing

With ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
With ActiveDocument.PageSetup
.Orientation = wdOrientLandscape
.TopMargin = InchesToPoints(0)
.BottomMargin = InchesToPoints(0)
.LeftMargin = InchesToPoints(0)
.RightMargin = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(11.69)
.PageHeight = InchesToPoints(8.27)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.VerticalAlignment = wdAlignVerticalTop
.BookFoldPrintingSheets = 1
End With


Dim oILShp As InlineShape

For Each oILShp In ActiveDocument.InlineShapes
oILShp.Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Next

For Each oILShp In ActiveDocument.InlineShapes
With oILShp
.Height = InchesToPoints(8.27)
.Width = InchesToPoints(11.69)
End With

Next

' i pasted the excel formula below
StrNewPath =
strDocName =

ActiveDocument.ExportAsFixedFormat OutputFileName:= _
StrNewPath & "\" & strDocName & ".pdf", ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False

End Sub

[fumei]

Your stuff is Excel, not Word VBA. Excel formula do not work in Word. I am not sure what you want to end up with...

Eg:
if "StrPath = .SelectedItems(1)" fetchs the path as "C:\Documents and Settings\QI_3618\Desktop\kumar.jpeg"
then StrNewPath shall become "C:\Documents and Settings\QI_3618"
and strDocName shall become "Desktop"

1. StrNewPath shall become "C:\Documents and Settings\QI_3618" is NOT a valid path. You need the pathn separator (\)

2. strDocName shall become "Desktop"

Desktop is a folder.

[fumei]

You may be looking for something like:Dim myPath As String
myPath = "C:\Documents and Settings\QI_3618\Desktop\kumar.jpeg"
MsgBox Left(myPath, InStrRev(myPath, "\"))

This returns:

C:\Documents and Settings\QI_3618\Desktop\

which IS a fully qualified path.

[Kumarcoolz]

i came to know that Excel formula do not work in Word only when i executed them.

i wanted to end up with "desktop" as the file name


Your stuff is Excel, not Word VBA. Excel formula do not work in Word. I am not sure what you want to end up with...
Eg:
if "StrPath = .SelectedItems(1)" fetchs the path as "C:\Documents and Settings\QI_3618\Desktop\kumar.jpeg"
then StrNewPath shall become "C:\Documents and Settings\QI_3618"
and strDocName shall become "Desktop"

1. StrNewPath shall become "C:\Documents and Settings\QI_3618" is NOT a valid path. You need the pathn separator (\)

2. strDocName shall become "Desktop"

Desktop is a folder.

i modified your code a bit to get my first objective. it will be gr8 if you could suggest me on how to make "desktop" as the filename.

Sub pathtest()
Dim StrPath As String
Dim StrNewPath As String
StrPath = "C:\Documents and Settings\QI_3618\Desktop\kumar.jpeg"

StrNewPath = Left(StrPath, InStrRev(StrPath, "\", -1) - 1)
StrNewPath = Left(StrNewPath, InStrRev(StrNewPath, "\", -1))
End Sub



You may be looking for something like:Dim myPath As String
myPath = "C:\Documents and Settings\QI_3618\Desktop\kumar.jpeg"
MsgBox Left(myPath, InStrRev(myPath, "\"))

This returns:

C:\Documents and Settings\QI_3618\Desktop\

which IS a fully qualified path.

If you could have a look at the end of the main code again where the code to convert the document into pdf

OutputFileName:= StrNewPath & "\" & strDocName & ".pdf"

Setting StrNewPath = C:\Documents and Settings\QI_3618
Setting StrDocName = Desktop (Filename)
has been my only intension.


Thanks alot Fumei:)

[Kumarcoolz]

Thanks to your suggestion, Fumei i came up with the logic of using the same excel formula in a way that word VBA accepts. the code now works as i intended it to work. Thanks again. i have added the fully complete code for reference :cloud9:
Sub InsertImages()
Dim doc As Word.Document
Dim bkmName As String
Dim SigFile As String
Dim fd As FileDialog
Dim mg2 As Range
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Set doc = ActiveDocument
Dim vrtSelectedItem As Variant
Dim theText() As String
Dim theText2 As String
Dim Char As Characters
Dim StrPath As String
Dim StrNewPath As String
Dim strDocName As String
Dim fso As Object
Dim fold As Object
Dim files As Object

' change the page orientation to landscape

With ActiveDocument.PageSetup
.Orientation = wdOrientLandscape
.TopMargin = InchesToPoints(0)
.BottomMargin = InchesToPoints(0)
.LeftMargin = InchesToPoints(0)
.RightMargin = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(11.69)
.PageHeight = InchesToPoints(8.27)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.VerticalAlignment = wdAlignVerticalTop
.BookFoldPrintingSheets = 1
End With

' selecting the CGM files

With fd
.Filters.Add "Computer Graphics Metafile", "*.jpg", 1

.FilterIndex = 1

If .Show = -1 Then
StrPath = .SelectedItems(1)
For Each vrtSelectedItem In .SelectedItems

Set mg2 = ActiveDocument.Range
mg2.Collapse wdCollapseEnd

doc.InlineShapes.AddPicture _
FileName:=vrtSelectedItem, _
LinkToFile:=False, SaveWithDocument:=True, Range:=mg2

Kill vrtSelectedItem
Next vrtSelectedItem
Else

MsgBox ("No Images Selected")
Exit Sub
End If

End With

Set fd = Nothing

'pasting the CGM files


With ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With


Dim oILShp As InlineShape

For Each oILShp In ActiveDocument.InlineShapes
oILShp.Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Next

For Each oILShp In ActiveDocument.InlineShapes
With oILShp
.Height = InchesToPoints(8.27)
.Width = InchesToPoints(11.69)
End With

Next


' converting the file to PDF

StrNewPath = Left(StrPath, InStrRev(StrPath, "\", -1) - 1)
StrNewPath = Left(StrNewPath, InStrRev(StrNewPath, "\", -1))

strDocName = Replace(StrPath, "\", Chr(45), 1, (Len(StrPath) - Len(Replace(StrPath, "\", ""))) - 2)
strDocName = Right(strDocName, Len(StrPath) - InStr(strDocName, "\"))
strDocName = Left(strDocName, InStrRev(strDocName, "\", -1) - 1)



ActiveDocument.ExportAsFixedFormat OutputFileName:= _
StrNewPath & strDocName & ".pdf", ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False

'deleting the folder

Set fso = CreateObject("Scripting.FilesystemObject")
Set fold = fso.GetFolder(StrNewPath & strDocName)
Set files = fold.files



If files.Count = 0 Then

RmDir StrNewPath & strDocName
End If


Selection.WholeStory
Selection.Delete

'changing the word document to default

ActiveDocument.Content.Orientation = wdTextOrientationHorizontal
With ActiveDocument.PageSetup
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(1)
.BottomMargin = InchesToPoints(1)
.LeftMargin = InchesToPoints(0.69)
.RightMargin = InchesToPoints(0.69)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(8.5)
.PageHeight = InchesToPoints(11)
.SectionStart = wdSectionNewPage
.VerticalAlignment = wdAlignVerticalTop


End With



End Sub

[fumei]

Good for you. I am glad it worked out. Thanks for posting your full solution.